ltq/0000755000076500007650000000000010564717607013111 5ustar ptolemyptolemy00000000000000ltq/._.DS_Store0000400000076500000000000000012210407762355014357 0ustar ptolemywheel00000000000000Mac OS X  2 R@ltq/.DS_Store0000644000076500007650000001400410407762355014567 0ustar ptolemyptolemy00000000000000Bud1%  @€ @€ @€ @ E%DSDB`€ @€ @€ @ltq/dopp.m0000755000076500007650000002125110564716337014234 0ustar ptolemyptolemy00000000000000:- module dopp. % synopsis: Dynamic-Op Pre-Processor (dopp) examines Mercury files for % 'op'/3 declarations (which currently only have effect % within the file of the declarations, meaning that these % declarations should only be in the implementation % section). With these declarations, it then transforms the % syntax of the module from op-enhanced to plain-jane % Mercury. % created: March 2, 2006 % author: Douglas M. Auclair (DMA) % modified: May 6, 2006, DMA % changed: Enprettified text formatting and added comments throughout. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module require, term, term_io, ops, map, pair, string, list, maybe. % We need to have our own op table, first, to allow the ':- % op'/3 declaration, and, second, to accumulate the % dynamically-declared syntax. So, we need to externalize % some of the implementation of the ops module from the % standard libraries. % fixidity describes the kind of syntax being declared. :- type fixidity ---> prefix ; infix ; postfix. % dynamic_op_table maps the syntax to its transformation :- type dynamic_op_table ---> dynamic_op_table(map(pair(string, fixidity), ops.op_info), ops.table). % The below instance declaration and definitions permit the % dynamically-declared syntax to be read in. Basically, we % check for the newly-declared syntax, failing that we punt to % the standard library ops module functionality. :- instance ops.op_table(dynamic_op_table) where [ pred(lookup_infix_op/5) is dynamic_op_lookup_infix_op, lookup_operator_term(_Table, 120, y, x), pred(lookup_prefix_op/4) is dynamic_op_lookup_prefix_op, pred(lookup_binary_prefix_op/5) is dynamic_op_lookup_binary_prefix_op, pred(lookup_postfix_op/4) is dynamic_op_lookup_postfix_op, pred(lookup_op/2) is dynamic_op_lookup_op, pred(lookup_op_infos/4) is dynamic_op_lookup_op_infos, max_priority(_) = 1200, arg_priority(_) = 1201 ]. :- pred dynamic_op_lookup_infix_op(dynamic_op_table::in, string::in, priority::out, assoc::out, assoc::out) is semidet. dynamic_op_lookup_infix_op(dynamic_op_table(Map, Table), Op, Priority, Pre, Post) :- search(Map, Op - infix, op_info(Spec, Pri0)) -> Priority = Pri0, Spec = infix(Pre, Post) ; lookup_infix_op(Table, Op, Priority, Pre, Post). :- pred dynamic_op_lookup_prefix_op(dynamic_op_table::in, string::in, ops.priority::out, ops.assoc::out) is semidet. dynamic_op_lookup_prefix_op(dynamic_op_table(Map, Table), Op, Pri, Pre) :- (search(Map, Op - prefix, op_info(Spec, Pri0)) -> Pri = Pri0, Spec = prefix(Pre) ; lookup_prefix_op(Table, Op, Pri, Pre)). :- pred dynamic_op_lookup_binary_prefix_op(dynamic_op_table::in, string::in, priority::out, ops.assoc::out, ops.assoc::out) is semidet. dynamic_op_lookup_binary_prefix_op(dynamic_op_table(Map, Table), Op, Priority, Fst, Snd) :- search(Map, Op - prefix, op_info(Spec, Pri0)), Spec = binary_prefix(One, Two) -> Fst = One, Snd = Two, Priority = Pri0 ; lookup_binary_prefix_op(Table, Op, Priority, Fst, Snd). :- pred dynamic_op_lookup_postfix_op(dynamic_op_table::in, string::in, ops.priority::out, ops.assoc::out) is semidet. dynamic_op_lookup_postfix_op(dynamic_op_table(Map, Table), Op, Pri, Post) :- search(Map, Op - postfix, op_info(Spec, Pri0)) -> Pri = Pri0, Spec = postfix(Post) ; lookup_postfix_op(Table, Op, Pri, Post). :- pred dynamic_op_lookup_op(dynamic_op_table::in, string::in) is semidet. dynamic_op_lookup_op(dynamic_op_table(Map, Table), Op) :- lookup_op(Table, Op) ; search(Map, Op - prefix, _) ; search(Map, Op - infix, _) ; search(Map, Op - postfix, _). % Currently we do nothing for alternates -- TODO: make this work :- pred dynamic_op_lookup_op_infos(dynamic_op_table::in, string::in, op_info::out, list(op_info)::out) is semidet. dynamic_op_lookup_op_infos(dynamic_op_table(Map, Table), Op, OpInfo, OpInfos) :- (search(Map, Op - prefix, Op1) -> A = yes(Op1); A = no), (search(Map, Op - postfix, Op2) -> B = yes(Op2); B = no), (search(Map, Op - infix, Op3) -> C = yes(Op3); C = no), (lookup_op_infos(Table, Op, Op4, Opses) -> D = yes(Op4), E = Opses ; D = no, E = []), (A = yes(Op5) -> OpInfo = Op5, list_from_maybes([B, C, D], E, OpInfos) ; B = yes(Op6) -> OpInfo = Op6, list_from_maybes([C, D], E, OpInfos) ; C = yes(Op7) -> OpInfo = Op7, list_from_maybes([D], E, OpInfos) ; D = yes(Op8), OpInfo = Op8, OpInfos = E). :- pred list_from_maybes(list(maybe(op_info)), list(op_info), list(op_info)). :- mode list_from_maybes(in, in, out) is det. list_from_maybes([]) --> []. list_from_maybes([Maybe|Rest]) --> ({ Maybe = yes(OpInfo) } -> cons(OpInfo); []), list_from_maybes(Rest). main --> command_line_arguments(Depends), print("Executing dopp "), write_list(Depends, " ", print), nl, ({ Depends = [_|_] } -> foreach_file(Depends); show_usage). :- pred show_usage(io::di, io::uo) is det. show_usage --> print("Hey! dopp file1.m [file2.m [...]]\n"). % creates a new dynamic op table for each of the files being % scanned, then gives the plain-jane Mercury equivalent file % as a result of the op-enhanced scan. :- pred foreach_file(list(string)::in, io::di, io::uo) is det. foreach_file([]) --> []. foreach_file([File|Files]) --> tell(File, _), see("../" ++ File, _), loopy(dynamic_op_table(map.init, init_mercury_op_table)), seen, told, foreach_file(Files). :- pred loopy(dynamic_op_table::in, io::di, io::uo) is det. loopy(Table) --> nl, read_term_with_op_table(Table, Term), print_term(Table, Term). :- pred print_term(dynamic_op_table::in, read_term(generic)::in, io::di, io::uo) is det. print_term(Table, term(Varset, Term)) --> ({ add_operator(Term, Table, Table1) } -> { NewTable = Table1 } ; print_line_number_directive(Term), write_term(Varset, Term), print("."), { NewTable = Table }), loopy(NewTable). print_term(_, Err@error(_A, _B)) --> print(Err), nl, { error("Error") }. print_term(_, eof) --> []. :- pred print_line_number_directive(term(generic)::in, io::di, io::uo) is det. print_line_number_directive(Term) --> { line_number(Term, Num) } -> format("#%d\n", [i(Num)]); []. :- pred line_number(term(generic)::in, int::out) is semidet. line_number(functor(_, _, context(_, Num)), Num). % When we encounter a new op declaration, we add that syntax % to our dynamic op table so we can scan that new item when used. :- pred add_operator(term(generic)::in, dynamic_op_table::in, dynamic_op_table::out) is semidet. add_operator(Term, dynamic_op_table(Map0, Table), dynamic_op_table(Map1, Table)) :- op_definition(Term, OpInfo, Op), Fixme = op_fixidity_from_op_info(OpInfo), map.det_insert(Map0, Op - Fixme, OpInfo, Map1). % Here's the payoff: this predicate locates op declarations % and gives the arguments that declares the new syntax. :- pred op_definition(term(generic)::in, op_info::out, string::out) is semidet. op_definition(functor(atom(":-"), [functor(atom("op"), [functor(integer(Precedence), [], _context0), functor(atom(Spec), [], _context1), functor(atom(Op), [], _context2)], _context3)], _context4), gimme_op_info(Spec, Precedence), Op). % Here are some implementation details of the standard library % ops module that we need to use in order to interact with an % op-enhanced file. :- func gimme_op_info(string, int) = op_info. gimme_op_info(String, Prec) = op_info(Class, Prec) :- class_from_string(String, Spec) -> Class = Spec ; error("Unknown op specifier: " ++ String). :- pred class_from_string(string::in, class::out) is semidet. class_from_string("fx", prefix(x)). class_from_string("fy", prefix(y)). class_from_string("xf", postfix(x)). class_from_string("yf", postfix(y)). class_from_string("xfx", infix(x, x)). class_from_string("yfx", infix(y, x)). class_from_string("xfy", infix(x, y)). class_from_string("fxx", binary_prefix(x, x)). class_from_string("fyx", binary_prefix(y, x)). class_from_string("fxy", binary_prefix(x, y)). :- func op_fixidity_from_op_info(op_info) = fixidity. op_fixidity_from_op_info(op_info(prefix(_), _)) = prefix. op_fixidity_from_op_info(op_info(postfix(_), _)) = postfix. op_fixidity_from_op_info(op_info(infix(_, _), _)) = infix. op_fixidity_from_op_info(op_info(binary_prefix(_, _), _)) = prefix. ltq/ltq.m0000755000076500007650000000731710427757221014074 0ustar ptolemyptolemy00000000000000:- module ltq. % synopsis: Builds an executable from Mercury files -- including % plain-vanilla modules as well as ones enhanced with % op/3 syntax. % author: Douglas M. Auclair (DMA) % created: March 2, 2006 % modified: May 6, 2006, DMA % changed: Added parameter to generate qcheck dependencies (types % that allow referencing predicates as items during runtime) % modified: March 29, 2006, DMA % changed: "Automagically" create the build/ directory so to deposit % the results of source-to-source transformations of the % canonically represented op-relations without causing the % make process to come to a screeching halt when it can't % find the non-existant build/ directory. % modified: March 23, 2006, DMA % changed: Made the arguments to mmc consistent for building % libraries or executables (added --infer-all to library % install make command). % modified: March 13, 2006, DMA % changed: checking for the prefix "lib" for a build object and then % create the appropriate makefile to build a library. % modified: March 10, 2006, DMA % changed: Expanded the argument list to the builder -- the final % argument is the executable to be built, all preceeding % ones are passed to mmc unmolested. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module bool, list, pair, string. main --> progname_base("ltq", LTQ), command_line_arguments(Args), format("Executing %s ", [s(LTQ)]), write_list(Args, " ", print), nl, ({ last(Args, ExecutableOrLibrary) } -> { qcheck_flag_check(Args) = Extension }, build_library_or_executable(Args, ExecutableOrLibrary), call_system("cd build; make " ++ ExecutableOrLibrary ++ Extension, _) ; show_usage(LTQ)). :- func qcheck_flag_check(list(string)) = string. qcheck_flag_check(Args) = Extension :- Args = [Qcheck|_], (Qcheck = "--qcheck-generate-predicate-types"; Qcheck = "-qgpt") -> Extension = "-quick" ; Extension = "". :- pred show_usage(string::in, io::di, io::uo) is det. show_usage(LTQ) --> print("Hey! " ++ LTQ ++ "[(--qcheck-generate-predicate-types|-qgpt)" ++ "|mmc options] \n"). :- pred build_library_or_executable(list(string), string, io, io). :- mode build_library_or_executable(in, in, di, uo) is det. build_library_or_executable(Args, ExecutableOrLibrary) --> { executable_name(ExecutableOrLibrary) = Executable - IsLibrary }, call_system("mkdir -p build", _), call_system("mmc -M " ++ Executable ++ "; mv " ++ Executable ++ ".d* build/", _), tell("build/Makefile", _), print("include " ++ Executable ++ ".dv\n\n"), print(ExecutableOrLibrary ++ ":\n\tdopp $(" ++ Executable ++ ".ms); \\\n\tmmc --make --infer-all "), write_list(Args, " ", print), install_command(IsLibrary, Executable, Args), print("\n\n" ++ ExecutableOrLibrary ++ "-quick:\n\tqcpt $(" ++ Executable ++ ".ms)\n\n"), told. :- func executable_name(string) = pair(string, bool). executable_name(ExecutableOrLibrary) = Executable - IsLibrary :- string.append("lib", Exe, ExecutableOrLibrary) -> Executable = Exe, IsLibrary = yes ; Executable = ExecutableOrLibrary, IsLibrary = no. :- pred install_command(bool::in, string::in, list(string)::in, io::di, io::uo) is det. install_command(no, Executable, _Arg) --> print("; \\\n\tmv " ++ Executable ++ " .."). install_command(yes, _NoExe, Args) --> print("; echo 'type \"cd build; make install\" to install library'" ++ "\n\ninstall:\n\tmmc --make --infer-all "), write_list(Args, " ", print), print(".install"). ltq/qcpt.m0000644000076500007650000001731110427757221014233 0ustar ptolemyptolemy00000000000000:- module qcpt. % synopsis: QuickCheck Predicate Types (qcpt) generates module % qcheck.tests_digest.types which contains type information % of the modules tested and the exported predicates and % functions of those modules (which, of course, should have % associated unit tests). % author: Douglas M. Auclair (DMA) % created: May 6, 2006 % modified: May 8, 2006, DMA % changed: Converted list collections to sets to ensure uniqueness. % all_tested_predicates really should have module % qualifiers, so we're converting that list to the % full_predicate_signature type. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module int, list, require, set, string, svset, term, term_io. main --> command_line_arguments(Depends), print("Executing qcpt "), write_list(Depends, " ", print), nl, main_aux(Depends). :- pred main_aux(list(string)::in, io::di, io::uo) is det. main_aux([]) --> show_usage. main_aux(Depends@[File|Files]) --> tell("qcheck.tests_digest.types.m", _), print(":- module qcheck.tests_digest.types.\n\n"), header(File, Files), foreach_file(Depends, Depends, [], init), print(":- end_module qcheck.tests_digest.types.\n"), told. :- pred show_usage(io::di, io::uo) is det. show_usage --> print("Hey! qcpt file1.m [file2.m [...]]\n"). :- pred header(string::in, list(string)::in, io::di, io::uo) is det. header(File, Files) --> format(":- interface. :- import_module list. :- type tested_module ---> %s", [module_of(File)]), write_other_module_names(Files), print(":- func all_program_modules = list(program_module). :- func all_public_predicates = list(public_predicate). :- type public_predicate_signature ---> public_predicate / int. :- type full_predicate_signature ---> public(program_module, public_predicate_signature). :- type test_desc == pair(full_predicate_signature, string). :- type public_predicate ---> "). :- pred write_other_module_names(list(string)::in, io::di, io::uo) is det. write_other_module_names([]) --> print(".\n\n"). write_other_module_names([File|Files]) --> format("\n\t; %s", [module_of(File)]), write_other_module_names(Files). :- func module_of(string) = string.poly_type. module_of(File) = s(replace_all(File, ".m", "")). :- pred foreach_file(list(string)::in, list(string)::in, list(string)::in, set(string)::in, io::di, io::uo) is det. foreach_file([], Filenames, QualifiedFuncsPreds, BareFuncPredSet) --> { to_sorted_list(BareFuncPredSet, FPList) }, write_list(FPList, "\n\t; ", print), print(".\n\n:- implementation.\n\nall_program_modules = [\n\t"), { PolyModules = map(module_of, Filenames), map((pred(Poly::in, String::out) is det :- format("%s", [Poly], String)), PolyModules, Modules) }, write_list(Modules, ",\n\t", print), print("\n].\n\nall_public_predicates = [\n\t"), write_list(QualifiedFuncsPreds, ",\n\t", print), print("\n].\n\n"). foreach_file([File|Files], Filenames, TableIn, BareFuncPredSet0) --> see("../" ++ File, _), loopy(File, BareFuncPredSet0, Set, TableIn, TableOut), seen, foreach_file(Files, Filenames, TableOut, Set). :- pred loopy(string::in, set(string)::in, set(string)::out, list(string)::in, list(string)::out, io::di, io::uo) is det. loopy(File, !Set, !Table) --> read_term(Term), add_term(File, !Set, !Table, Term). :- pred add_term(string::in, set(string)::in, set(string)::out, list(string)::in, list(string)::out, read_term(generic)::in, io::di, io::uo) is det. add_term(File, !Set, !Table, term(_, Term)) --> add_decl(File, !Set, Term, !Table). add_term(_, !_, !_, Err@error(_A, _B)) --> print(Err), nl, { error(string(Err)) }. add_term(_, !_, !_, eof) --> []. :- pred add_decl(string::in, set(string)::in, set(string)::out, term(generic)::in, list(string)::in, list(string)::out, io::di, io::uo) is det. add_decl(File, !Set, Term0, !Table, !IO) :- check_for_impl_decl(Term0) -> true ; strip_purity_quantification_n_constraint_decls(Term0, Term), (ho_decl(Term, Name, Arity) -> svset.insert(Name, !Set), cons(format("tested(%s, %s/%d)", [module_of(File), s(Name), i(Arity)]), !Table) ; true), loopy(File, !Set, !Table, !IO). % We only care about the (bare) function or predicate % declaration; the purity, quantification or type-class % constraints of such types are not in the purview of this system. :- pred strip_purity_quantification_n_constraint_decls(term(generic), term(generic)). :- mode strip_purity_quantification_n_constraint_decls(in, out) is det. strip_purity_quantification_n_constraint_decls(TermIn, TermOut) :- purity_decl(TermIn, TermTmp0) -> strip_purity_quantification_n_constraint_decls(TermTmp0, TermOut) ; quant_decl(TermIn, TermTmp1) -> strip_purity_quantification_n_constraint_decls(TermTmp1, TermOut) ; constraint_decl(TermIn, TermTmp2) -> strip_purity_quantification_n_constraint_decls(TermTmp2, TermOut) ; TermOut = TermIn. % Here we check for "impure" or "semipure" and, finding one, % delete that declaration from the term. :- pred purity_decl(term(generic)::in, term(generic)::out) is semidet. purity_decl(functor(atom(":-"), [functor(atom(Purity), Terms, _)], Ctx), functor(atom(":-"), Terms, Ctx)) :- (Purity = "impure" ; Purity = "semipure"), Terms = [_|_]. % A user can quantify the arguments existentially or % universally; we say: "so what?" when we are generating the % predicate types, so we delete these "nice to know" decls :- pred quant_decl(term(generic)::in, term(generic)::out) is semidet. quant_decl(functor(atom(":-"), [functor(atom(Qut), [Vars|Terms], _)], Ctx), functor(atom(":-"), Terms, Ctx)) :- (Qut = "all" ; Qut = "some"), not is_ground(Vars), Terms = [_|_]. % Type class constraints, both universal and existential, do % not help us in discerning the type's arity. :- pred constraint_decl(term(generic)::in, term(generic)::out) is semidet. constraint_decl(functor(atom(":-"), [functor(atom(Constraint), [Pred|_TypeClasses], _)], Ctx), functor(atom(":-"), [Pred], Ctx)) :- (Constraint = "=>" ; Constraint = "<="). % When we enter the implementation section, we're done with % our work for this module. :- pred check_for_impl_decl(term(generic)::in) is semidet. check_for_impl_decl(functor(atom(":-"), [functor(atom("implementation"), [], _contx0)], _context1)). % Here's the payoff: this predicate locates op declarations % and gives the arguments that declares the new syntax. :- pred ho_decl(term(generic), string, int). :- mode ho_decl(in, out, out) is semidet. ho_decl(functor(atom(":-"), [functor(atom(PredOrFunc), [functor(atom(Functor), Args, _context0)|_], _context1)], _context2), Name, Arity) :- (PredOrFunc = "pred" ; PredOrFunc = "func"), (Functor = "is" -> moded_predicate(Args, Name, Arity) ; (Functor = "=" -> fn_decl(Args, Name, Arity) ; Name = Functor, Arity = length(Args))). % The term is a predicate declaration with embedded mode % information, so the "real" declaration is the first arg. :- pred moded_predicate(list(term(generic)), string, int). :- mode moded_predicate(in, out, out) is semidet. moded_predicate([functor(atom(Pred), Args, _cxt), _Det], Pred, length(Args)). % The term is a function declaration (which does not allow % embedded mode information); the arity must be incremented to % include the returned value. :- pred fn_decl(list(term(generic)), string, int). :- mode fn_decl(in, out, out) is semidet. fn_decl([functor(atom(Fn), Args, _context), _Ret], Fn, length(Args) + 1). ltq/samples/0000755000076500007650000000000010564720047014545 5ustar ptolemyptolemy00000000000000ltq/samples/._.DS_Store0000400000076500000000000000012210407762374016024 0ustar ptolemywheel00000000000000Mac OS X  2 R@ltq/samples/.DS_Store0000644000076500007650000001400410407762374016234 0ustar ptolemyptolemy00000000000000Bud1%  @€ @€ @€ @ E%DSDB`€ @€ @€ @ltq/samples/bar.m0000755000076500007650000000076410402224606015470 0ustar ptolemyptolemy00000000000000:- module bar. % synopsis: A separate sub-module of test_div ... it should NOT see % the 'divided_by' operator declared in test_div. % author: Douglas M. Auclair (DMA) % date: March 1, 2006, Ash Wednesday. :- interface. :- pred identity_transform(int::in, int::out) is det. % :- pred should_not_work_with_divided_by_op(float::in, float::in, % float::out) is det. :- implementation. identity_transform(X, X). % should_not_work_with_divided_by_op(A, B, C) :- C = A divided_by B. ltq/samples/cellular_automata_engine.m0000755000076500007650000001141510404210342021734 0ustar ptolemyptolemy00000000000000:- module cellular_automata_engine. % synopsis: Runs a 1-dimensional automaton against an input row, % generating a resulting row (truncated). One of the more % fameous (can I write "fameous" if hardly anyone even knows % about cellular automata, even?) rules is Rule 30, which % seems to generate a random result set from its % predecessor. % author: Douglas M. Auclair (DMA) % date: February 21, 2006 % modified: March 1, 2006, DMA, Ash Wednesday % changed: The first go was simply declaring, and then playing with, % the types. This revision actually implements the engine, % allowing any of the rules to be run, and then outputs the % row's value as (e.g.) a 32-bit integer. These integers % can be rolled into the planned 'series' typeclass so that, % e.g., rule30, tausworthe3 and the library/random.m could % be used in code depending on the user's desire. :- interface. :- import_module io, int, assoc_list. :- type bit == int. :- inst bit ---> 1; 0. :- type match == int. :- inst match ---> 111; 110; 101; 100; 011; 010; 001; 000. /* :- inst two_bits(T, End) == bound([T|bound([T|End])]). * :- inst four_play(T, End) == two_bits(T, two_bits(T, End)). * :- inst pieces_of_eight(T) == four_play(T, four_play(T, bound([]))). */ :- type canon ---> rul(assoc_list(match, bit)). :- pred main(io::di, io::uo) is cc_multi. :- implementation. :- import_module require, string, list. main --> command_line_arguments(Args), { ([Arg|Argu] = Args, RuleId = det_to_int(Arg), (Argu = [Genra|Hitomis], Gens = det_to_int(Genra), (Hitomis = [Gra|_], Sz = det_to_int(Gra); Sz = 31) ; Gens = 30, Sz = 31) ; Gens = 30, Sz = 31, RuleId = 30), % Bits = [_, _, _, _, _, _, _, _], Matchers = [111, 110, 101, 100, 011, 010, 001, 000], sift_to_rule(7, RuleId, [], Bits), from_corresponding_lists(Matchers, Bits, Patterns), Rule = rul(Patterns) }, print_rule(Rule, RuleId), nl, generations(Rule, Gens, Sz, [1]). /* :- pred sift_to_rule(list(int)::list_skel_in(free), int::in, int::in) is det. sift_to_rule([], _, _). sift_to_rule([H|T], Exp, Base) :- H = Base >> Exp, sift_to_rule(T, Exp - 1, Base - H << Exp). */ :- pred sift_to_rule(int::in, int::in, list(int)::in, list(int)::out) is det. sift_to_rule(Exp, Base, In, Out) :- Exp < 0 -> reverse(In, Out) ; H = Base >> Exp, sift_to_rule(Exp - 1, Base - H << Exp, [H|In], Out). :- pred generations(canon::in, int::in, int::in, list(int)::in, io::di, io::uo) is cc_multi. generations(Rule, X, Max, InputRow) --> print_row(InputRow, Max), ({ X > 0 } -> { translate_row(Rule, [0,0|InputRow], [], Ans) }, generations(Rule, X - 1, Max, Ans) ; []). :- pred print_rule(canon::in, int::in, io::di, io::uo) is det. print_rule(rul(Eight), Id) --> format("rule%d(", [i(Id)]), print_rule_pairs(Eight), print(")"). :- pred print_rule_pairs(assoc_list(K, V)::in, /* (pieces_of_eight(ground)), */ io::di, io::uo) is det. print_rule_pairs(Eight) --> print(Eight). translate_row(rul(Patterns), [H|T], In, Out) :- three_bits([H|T], Match), (search(Patterns, Match, B) -> Bit = B ; format("No match for %d", [i(Match)], Error), error(Error)), translate_row(rul(Patterns), T, [Bit|In], Out). translate_row(_, []) --> reverse. :- pred three_bits(list(int)::in, match::out(match)) is det. three_bits(List, Match) :- three_bits_from(List, A, B, C), Match = A * 100 + B * 10 + C. three_bits_from([], 0, 0, 0). three_bits_from([A], A, 0, 0). three_bits_from([A, B], A, B, 0). three_bits_from([A, B, C|_], A, B, C). truncate_preceeding_zeros(List@[Numeral|Rest], Ans) :- Numeral = 0 -> truncate_preceeding_zeros(Rest, Ans); Ans = List. print_row(Row, Max) --> { length(Row, Rlen), fit_into_bits(Max, Rlen, Num, Row, UsedRow), min(Max, Rlen, BitsUsed), max(0, (Max // 2) - BitsUsed // 2 + 5, Offset) }, print_spaces(Offset), write_list(UsedRow, "", write), format(" = %d/%d(%d)\n", [i(Num), i(BitsUsed), i(Rlen)]). :- pred print_spaces(int::in, io::di, io::uo) is det. print_spaces(X) --> { X > 0 } -> print(" "), print_spaces(X - 1); []. :- pred fit_into_bits(int::in, int::in, int::out, list(int)::in, list(int)::out) is det. fit_into_bits(Max, Len, Ans, Bits, UsedBits) :- Max > Len -> Ans = num_from(Bits) << ((Max - Len) / 2), UsedBits = Bits ; (drop((Len - Max - 1) / 2, Bits, Nybbles) -> take_upto(Max, Nybbles, Kibbles), num_from(Kibbles) = Ans, UsedBits = Kibbles ; error("List is impossibly short!")). num_from(SomeBits) = Num :- reverse(SomeBits, SomeOtherBits), num_from_aux(SomeOtherBits, 0, 0, Num). num_from_aux([], _) --> []. num_from_aux([H|T], Exp, Accum, Ans) :- num_from_aux(T, Exp + 1, Accum + H << Exp, Ans). ltq/samples/divu.m0000755000076500007650000000043510402224624015666 0ustar ptolemyptolemy00000000000000:- module divu. % synopsis: Defines the 'divided_by' op % author: Douglas M. Auclair (DMA) % date: March 1, 2006 :- interface. :- func divided_by(float, float) = float. :- implementation. :- import_module float. :- op(400, yfx, divided_by). A divided_by B = C :- C = A / B. ltq/samples/e.m0000644000076500007650000000777310564720047015165 0ustar ptolemyptolemy00000000000000%-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % File: e.m. % Main author: bromage. % This source file is hereby placed in the public domain. -bromage. % Calculate the base of natural logarithms using lazy evaluation. % The algorithm is O(N^2) in the number of digits requested. %-----------------------------------------------------------------------------% :- module e. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module int, list, require, char, string. % Default number of digits displayed (if this is not specified % on the command line). :- func default_digits = int. default_digits = 1000. % Change this for a base other than 10. Any integer between % 2 and 36 makes sense. :- func base = int. base = 10. % Number of columns on the terminal. :- func columns = int. columns = 78. %-----------------------------------------------------------------------------% % This is a simple implementation of an infinite lazy stream. :- type int_stream ---> [int | int_stream] ; closure((func) = int_stream). :- inst int_stream == bound([ground | int_stream] ; closure((func) = is_out is det)). :- mode is_in == in(int_stream). :- mode is_out == out(int_stream). %-----------------------------------------------------------------------------% % An infinite stream of ones. :- func ones = (int_stream :: is_out) is det. ones = [1 | closure((func) = ones)]. % All the digits of e in one stream. :- func digits_of_e = (int_stream :: is_out) is det. digits_of_e = next_digit(ones). :- func next_digit(int_stream::is_in) = (int_stream::is_out) is det. next_digit(Stream0) = [Digit | closure((func) = next_digit(Stream))] :- scale(2, Digit, Stream0, Stream). :- pred scale(int::in, int::out, int_stream::is_in, int_stream::is_out) is det. scale(C, Digit, closure(Func), Stream) :- scale(C, Digit, apply(Func), Stream). scale(C, Digit, [D | Ds], Stream) :- K = base * D, KdC = K // C, ( KdC = (K + base - 1) // C -> % We have the next digit. Construct a closure to % generate the rest. Digit = KdC, Stream = closure((func) = [K rem C + NextDigit | Stream0] :- scale(C + 1, NextDigit, Ds, Stream0) ) ; % We have a carry to factor in, so calculate the next % digit eagerly then add it on. scale(C + 1, A1, Ds, B1), Digit = (K + A1) // C, Stream = [(K + A1) rem C | B1] ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- type centiamps ---> centiamps(int). :- op(200, yf, centiamps). add(X centiamps, Y centiamps) = Z centiamps :- Z = X + Y. main(!IO) :- io.command_line_arguments(Args, !IO), ( Args = [Arg | _], string.to_int(Arg, Digits0) -> Digits = Digits0 ; Digits = default_digits ), Am centiamps = add(5 centiamps, 3 centiamps), print("I have ", !IO), write_int(Am, !IO), print(" centiamps\n", !IO), string.int_to_base_string(2, base, BaseString), io.write_strings([BaseString, "."], !IO), string.length(BaseString, BaseStringLength), main_2(Digits, columns - BaseStringLength - 1, digits_of_e, !IO), io.nl(!IO). % Print out digits until we don't have any more. :- pred main_2(int::in, int::in, int_stream::is_in, io::di, io::uo) is det. main_2(Digits, Columns, closure(Func), !IO) :- main_2(Digits, Columns, apply(Func), !IO). main_2(Digits, Columns, [I | Is], !IO) :- ( Digits = 0 -> true ; Columns = 0 -> io.nl(!IO), main_2(Digits, columns, [I | Is], !IO) ; char.det_int_to_digit(I, Digit), io.write_char(Digit, !IO), main_2(Digits - 1, Columns - 1, Is, !IO) ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% ltq/samples/play.m0000755000076500007650000000402610402227152015663 0ustar ptolemyptolemy00000000000000:- module play. :- interface. % synopsis: "The play is the thing ..." This module reflects an % exercise at the end of section 3.3 of Bratko's % /Prolog Programming for Artificial Intelligence, 3rd ed./, % enhanced with type information. op/3 is working nicely in % Mercury. % author: Douglas M. Auclair (DMA) % date: January 5, 2006 % % Just one question ... who is this 'geophf' person, anyway? :- import_module io. :- pred main(state::di, state::uo) is det. :- implementation. :- import_module list, int, string. :- type person ---> geophf; susan; jimmy; biff. :- type sport ---> go; rugby; basketball; football; volleyball; squash; halo; cricket. :- type sports ---> and(sport, sport). :- typeclass showable(T) where [ func show(T) = string ]. :- instance showable(person) where [ show(geophf) = "geophf", show(susan) = "Susan", show(jimmy) = "Jimmy", show(biff) = "Biff" ]. :- op(800, xfx, plays). % N.B.: op(720, xfy, and) is predefined in the Mercury language % Below are some "interesting" facts. jimmy plays football and squash. % 'Merkans call it "soccor" ... susan plays volleyball and basketball. % ... so the assertation: geophf plays halo and rugby. % "Boys play football; Men play Rugby" biff plays go and cricket. % can have different implications for % different people... main --> { jimmy plays What, Who plays halo and _, Susan plays _ and basketball }, print("Jimmy plays "), write(What), nl, % instead of the below, we could have discarded the typeclass % and simply wrote: 'write(Who), print(" plays halo\n").' &c. format("%s plays halo.\n ...huh? '%s'? Who's that?\n", [s(show(Who)), s(show(Who))]), format("%s plays basketball.\n", [s(show(Susan))]), % and one query ({ Biff plays go and cricket } -> format("%s plays go; which isn't exactly cricket, now, is it!", [s(show(Biff))]) ; print("What? No go? Is it tea time, then?")), nl. ltq/samples/test_div.m0000755000076500007650000000127610402224710016540 0ustar ptolemyptolemy00000000000000:- module test_div. % synopsis: Uses the 'div' op % author: Douglas M. Auclair (DMA) % date: March 1, 2006 :- interface. :- import_module io. :- module foo. :- interface. :- pred print_div(float::in, float::in, io::di, io::uo) is det. :- end_module foo. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module divu, test_div.foo, list, string. :- op(400, yfx, divided_by). :- module foo. :- implementation. :- import_module list, string. print_div(A, B) --> format("%f divided_by %f = %f\n", [f(A), f(B), f(A divided_by B)]). :- end_module foo. :- import_module bar. main --> print_div(5.0, 3.0), { identity_transform(5, X) }, format("Hey, i(5) is %d\n", [i(X)]).