KevinMidboe/linguist
1
0
Fork 0
mirror of https://github.com/KevinMidboe/linguist.git synced 2025-10-29 09:40:21 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #1098 from github/1049-update

Browse Source 
1049 update
This commit is contained in:
Arfon Smith
2014-04-21 17:13:45 -05:00
parent 5148422e39 b065d8c0d7
commit 9c921b331c
14 changed files with 19577 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
lib/linguist/languages.yml
View File

@@ -871,6 +871,9 @@ INI:
- .prefs
- .properties
primary_extension: .ini
Inno Setup:
primary_extension: .iss
Idris:
type: programming
@@ -1173,6 +1176,18 @@ MediaWiki:
wrap: true
primary_extension: .mediawiki
Mercury:
type: programming
# This is the background colour on the web page.
color: "#abcdef"
# The primary extension is .m, but lingist won't accept duplicates
primary_extension: .mercury
# Mercury's syntax is not prolog syntax, but they do share the lexer
lexer: Prolog
extensions:
- .m
- .moo
MiniD: # Legacy
searchable: false
primary_extension: .minid # Dummy extension

2934
lib/linguist/samples.json
View File

File diff suppressed because it is too large Load Diff

3
lib/linguist/vendor.yml
View File

@@ -186,3 +186,6 @@
# .DS_Store's
- .[Dd][Ss]_[Ss]tore$
# Mercury --use-subdirs
- Mercury/

4843
samples/Mercury/code_info.m Normal file
View File

File diff suppressed because it is too large Load Diff

72
samples/Mercury/expr.moo Normal file
View File

@@ -0,0 +1,72 @@
:- module expr.
:- interface.
:- import_module char, int, list.
:- type token
---> ('+')
; ('-')
; ('*')
; ('/')
; num(int)
; ('(')
; (')')
; eof
.
:- parse(exprn/1, token, eof, xx, in, out).
:- pred scan(list(char), list(token)).
:- mode scan(in, out) is det.
:- implementation.
:- import_module string, require.
:- rule exprn(int).
exprn(Num) ---> exprn(A), [+], term(B), { Num = A + B }.
exprn(Num) ---> exprn(A), [-], term(B), { Num = A - B }.
exprn(Num) ---> term(Num).
:- rule term(int).
term(Num) ---> term(A), [*], factor(B), { Num = A * B }.
term(Num) ---> term(A), [/], factor(B), { Num = A // B }.
term(Num) ---> factor(Num).
:- rule factor(int).
factor(Num) ---> ['('], exprn(Num), [')'].
factor(Num) ---> [num(Num)].
scan(Chars, Toks) :-
scan(Chars, [], Toks0),
list__reverse(Toks0, Toks).
:- pred scan(list(char), list(token), list(token)).
:- mode scan(in, in, out) is det.
scan([], Toks, [eof|Toks]).
scan([C|Cs], Toks0, Toks) :-
( char__is_whitespace(C) ->
scan(Cs, Toks0, Toks)
; char__is_digit(C) ->
takewhile(char__is_digit, [C|Cs], Digits, Rest),
string__from_char_list(Digits, NumStr),
Num = string__det_to_int(NumStr),
scan(Rest, [num(Num)|Toks0], Toks)
; C = ('+') ->
scan(Cs, ['+'|Toks0], Toks)
; C = ('-') ->
scan(Cs, ['-'|Toks0], Toks)
; C = ('*') ->
scan(Cs, ['*'|Toks0], Toks)
; C = ('/') ->
scan(Cs, ['/'|Toks0], Toks)
; C = ('(') ->
scan(Cs, ['('|Toks0], Toks)
; C = (')') ->
scan(Cs, [')'|Toks0], Toks)
;
error("expr: syntax error in input")
).

14
samples/Mercury/hello.m Normal file
View File

@@ -0,0 +1,14 @@
% "Hello World" in Mercury.
% This source file is hereby placed in the public domain. -fjh (the author).
:- module hello.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
main(!IO) :-
io.write_string("Hello, world\n", !IO).

5884
samples/Mercury/options.m Normal file
View File

File diff suppressed because it is too large Load Diff

4637
samples/Mercury/polymorphism.m Normal file
View File

File diff suppressed because it is too large Load Diff

58
samples/Mercury/rot13_concise.m Normal file
View File

@@ -0,0 +1,58 @@
% File: rot13_concise.m
% Main authors: Warwick Harvey <wharvey@cs.monash.edu.au>
% Fergus Henderson <fjh@cs.mu.oz.au>
%
% rot13_concise:
%
% Program to read its input, apply the rot13 algorithm, and write it out
% again.
%
% This version is more concise (but less efficient) than its companion,
% rot13_verbose.
%
% Key features:
% - is independent of character set (e.g. ASCII, EBCDIC)
% - has proper error handling
%
:- module rot13_concise.
:- interface.
:- import_module io.
:- pred main(state, state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module char, int, string.
% The length of `alphabet' should be a multiple of `cycle'.
alphabet = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ".
cycle = 26.
rot_n(N, Char) = RotChar :-
char_to_string(Char, CharString),
( if sub_string_search(alphabet, CharString, Index) then
NewIndex = (Index + N) mod cycle + cycle * (Index // cycle),
index_det(alphabet, NewIndex, RotChar)
else
RotChar = Char
).
rot13(Char) = rot_n(13, Char).
main -->
read_char(Res),
( { Res = ok(Char) },
print(rot13(Char)),
main
; { Res = eof }
; { Res = error(ErrorCode) },
{ error_message(ErrorCode, ErrorMessage) },
stderr_stream(StdErr),
print(StdErr, "rot13: error reading input: "),
print(StdErr, ErrorMessage),
nl(StdErr)
).

50
samples/Mercury/rot13_ralph.m Normal file
View File

@@ -0,0 +1,50 @@
% ---------------------------------------------------------------------------- %
% rot13_ralph.m
% Copyright (C) 2001 Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 18:10:44 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
%
% Short and sweet.
%
% ---------------------------------------------------------------------------- %
:- module rot13_ralph.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
:- implementation.
:- import_module int, require.
% ---------------------------------------------------------------------------- %
main -->
io__read_byte(Result),
( { Result = ok(X) }, io__write_byte(rot13(X)), main
; { Result = eof }
; { Result = error(ErrNo)}, { error(io__error_message(ErrNo)) }
).
% ---------------------------------------------------------------------------- %
:- func rot13(int) = int.
rot13(X) =
( if 0'a =< X, X =< 0'z then Rot13(X, 0'a)
else if 0'A =< X, X =< 0'Z then Rot13(X, 0'A)
else X
)
:-
Rot13 = ( func(C, A) = ((13 + C - A) `rem` 26) + A ).
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %

116
samples/Mercury/rot13_verbose.m Normal file
View File

@@ -0,0 +1,116 @@
% File: rot13_verbose.m
% Main author: Warwick Harvey <wharvey@cs.monash.edu.au>
% Additional input: Fergus Henderson <fjh@cs.mu.oz.au>
%
% rot13_verbose:
%
% Program to read its input, apply the rot13 algorithm, and write it out
% again.
%
% This version is more verbose (and more efficient) than its companion,
% rot13_concise.
%
% Key features:
% - is independent of character set (e.g. ASCII, EBCDIC)
% - has proper error handling
% - reasonably efficient (uses a table to do the rotation)
%
:- module rot13_verbose.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module char, int, require.
% rot13a/2
% A table to map the alphabetic characters to their rot13 equivalents
% (fails if the input is not alphabetic).
:- pred rot13a(char, char).
:- mode rot13a(in, out) is semidet.
rot13a('a', 'n').
rot13a('b', 'o').
rot13a('c', 'p').
rot13a('d', 'q').
rot13a('e', 'r').
rot13a('f', 's').
rot13a('g', 't').
rot13a('h', 'u').
rot13a('i', 'v').
rot13a('j', 'w').
rot13a('k', 'x').
rot13a('l', 'y').
rot13a('m', 'z').
rot13a('n', 'a').
rot13a('o', 'b').
rot13a('p', 'c').
rot13a('q', 'd').
rot13a('r', 'e').
rot13a('s', 'f').
rot13a('t', 'g').
rot13a('u', 'h').
rot13a('v', 'i').
rot13a('w', 'j').
rot13a('x', 'k').
rot13a('y', 'l').
rot13a('z', 'm').
rot13a('A', 'N').
rot13a('B', 'O').
rot13a('C', 'P').
rot13a('D', 'Q').
rot13a('E', 'R').
rot13a('F', 'S').
rot13a('G', 'T').
rot13a('H', 'U').
rot13a('I', 'V').
rot13a('J', 'W').
rot13a('K', 'X').
rot13a('L', 'Y').
rot13a('M', 'Z').
rot13a('N', 'A').
rot13a('O', 'B').
rot13a('P', 'C').
rot13a('Q', 'D').
rot13a('R', 'E').
rot13a('S', 'F').
rot13a('T', 'G').
rot13a('U', 'H').
rot13a('V', 'I').
rot13a('W', 'J').
rot13a('X', 'K').
rot13a('Y', 'L').
rot13a('Z', 'M').
% rot13/2
% Applies the rot13 algorithm to a character.
:- pred rot13(char, char).
:- mode rot13(in, out) is det.
rot13(Char, RotChar) :-
( if rot13a(Char, TmpChar) then
RotChar = TmpChar
else
RotChar = Char
).
main -->
io__read_char(Res),
( { Res = ok(Char) },
{ rot13(Char, RotChar) },
io__write_char(RotChar),
main
; { Res = eof }
; { Res = error(ErrorCode) },
{ io__error_message(ErrorCode, ErrorMessage) },
io__stderr_stream(StdErr),
io__write_string(StdErr, "rot13: error reading input: "),
io__write_string(StdErr, ErrorMessage),
io__nl(StdErr)
).

930
samples/Mercury/store.m Normal file
View File

@@ -0,0 +1,930 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-1997, 2000-2008, 2010-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: store.m.
% Main author: fjh.
% Stability: low.
%
% This file provides facilities for manipulating mutable stores.
% A store can be considered a mapping from abstract keys to their values.
% A store holds a set of nodes, each of which may contain a value of any
% type.
%
% Stores may be used to implement cyclic data structures such as circular
% linked lists, etc.
%
% Stores can have two different sorts of keys:
% mutable variables (mutvars) and references (refs).
% The difference between mutvars and refs is that mutvars can only be updated
% atomically, whereas it is possible to update individual fields of a
% reference one at a time (presuming the reference refers to a structured
% term).
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module store.
:- interface.
:- import_module io.
%-----------------------------------------------------------------------------%
% Stores and keys are indexed by a type S of typeclass store(S) that
% is used to distinguish between different stores. By using an
% existential type declaration for store.new (see below), we use the
% type system to ensure at compile time that you never attempt to use
% a key from one store to access a different store.
%
:- typeclass store(T) where [].
:- type store(S).
:- instance store(io.state).
:- instance store(store(S)).
% Initialize a new store.
%
:- some [S] pred store.init(store(S)::uo) is det.
%-----------------------------------------------------------------------------%
%
% Mutvars
%
% generic_mutvar(T, S):
% A mutable variable holding a value of type T in store S.
%
:- type generic_mutvar(T, S).
:- type io_mutvar(T) == generic_mutvar(T, io.state).
:- type store_mutvar(T, S) == generic_mutvar(T, store(S)).
% Create a new mutable variable, initialized with the specified value.
%
:- pred store.new_mutvar(T::in, generic_mutvar(T, S)::out, S::di, S::uo)
is det <= store(S).
% copy_mutvar(OldMutvar, NewMutvar, S0, S) is equivalent to the sequence
% get_mutvar(OldMutvar, Value, S0, S1),
% new_mutvar(NewMutvar, Value, S1, S )
%
:- pred store.copy_mutvar(generic_mutvar(T, S)::in, generic_mutvar(T, S)::out,
S::di, S::uo) is det <= store(S).
% Lookup the value stored in a given mutable variable.
%
:- pred store.get_mutvar(generic_mutvar(T, S)::in, T::out,
S::di, S::uo) is det <= store(S).
% Replace the value stored in a given mutable variable.
%
:- pred store.set_mutvar(generic_mutvar(T, S)::in, T::in,
S::di, S::uo) is det <= store(S).
% new_cyclic_mutvar(Func, Mutvar):
%
% Create a new mutable variable, whose value is initialized
% with the value returned from the specified function `Func'.
% The argument passed to the function is the mutvar itself,
% whose value has not yet been initialized (this is safe
% because the function does not get passed the store, so
% it can't examine the uninitialized value).
%
% This predicate is useful for creating self-referential values
% such as circular linked lists.
% For example:
%
% :- type clist(T, S) ---> node(T, mutvar(clist(T, S))).
%
% :- pred init_cl(T::in, clist(T, S)::out,
% store(S)::di, store(S)::uo) is det.
%
% init_cl(X, CList, !Store) :-
% store.new_cyclic_mutvar(func(CL) = node(X, CL), CList,
% !Store).
%
:- pred store.new_cyclic_mutvar((func(generic_mutvar(T, S)) = T)::in,
generic_mutvar(T, S)::out, S::di, S::uo) is det <= store(S).
%-----------------------------------------------------------------------------%
%
% References
%
% generic_ref(T, S):
%
% A reference to value of type T in store S.
%
:- type generic_ref(T, S).
:- type io_ref(T, S) == generic_ref(T, io.state).
:- type store_ref(T, S) == generic_ref(T, store(S)).
% new_ref(Val, Ref):
% /* In C: Ref = malloc(...); *Ref = Val; */
%
% Given a value of any type `T', insert a copy of the term
% into the store and return a new reference to that term.
% (This does not actually perform a copy, it just returns a view
% of the representation of that value.
% It does however allocate one cell to hold the reference;
% you can use new_arg_ref to avoid that.)
%
:- pred store.new_ref(T::di, generic_ref(T, S)::out,
S::di, S::uo) is det <= store(S).
% ref_functor(Ref, Functor, Arity):
%
% Given a reference to a term, return the functor and arity
% of that term.
%
:- pred store.ref_functor(generic_ref(T, S)::in, string::out, int::out,
S::di, S::uo) is det <= store(S).
% arg_ref(Ref, ArgNum, ArgRef):
% /* Pseudo-C code: ArgRef = &Ref[ArgNum]; */
%
% Given a reference to a term, return a reference to
% the specified argument (field) of that term
% (argument numbers start from zero).
% It is an error if the argument number is out of range,
% or if the argument reference has the wrong type.
%
:- pred store.arg_ref(generic_ref(T, S)::in, int::in,
generic_ref(ArgT, S)::out, S::di, S::uo) is det <= store(S).
% new_arg_ref(Val, ArgNum, ArgRef):
% /* Pseudo-C code: ArgRef = &Val[ArgNum]; */
%
% Equivalent to `new_ref(Val, Ref), arg_ref(Ref, ArgNum, ArgRef)',
% except that it is more efficient.
% It is an error if the argument number is out of range,
% or if the argument reference has the wrong type.
%
:- pred store.new_arg_ref(T::di, int::in, generic_ref(ArgT, S)::out,
S::di, S::uo) is det <= store(S).
% set_ref(Ref, ValueRef):
% /* Pseudo-C code: *Ref = *ValueRef; */
%
% Given a reference to a term (Ref),
% a reference to another term (ValueRef),
% update the store so that the term referred to by Ref
% is replaced with the term referenced by ValueRef.
%
:- pred store.set_ref(generic_ref(T, S)::in, generic_ref(T, S)::in,
S::di, S::uo) is det <= store(S).
% set_ref_value(Ref, Value):
% /* Pseudo-C code: *Ref = Value; */
%
% Given a reference to a term (Ref), and a value (Value),
% update the store so that the term referred to by Ref
% is replaced with Value.
%
:- pred store.set_ref_value(generic_ref(T, S)::in, T::di,
S::di, S::uo) is det <= store(S).
% Given a reference to a term, return that term.
% Note that this requires making a copy, so this pred may
% be inefficient if used to return large terms; it
% is most efficient with atomic terms.
% XXX current implementation buggy (does shallow copy)
%
:- pred store.copy_ref_value(generic_ref(T, S)::in, T::uo,
S::di, S::uo) is det <= store(S).
% Same as above, but without making a copy. Destroys the store.
%
:- pred store.extract_ref_value(S::di, generic_ref(T, S)::in, T::out)
is det <= store(S).
%-----------------------------------------------------------------------------%
%
% Nasty performance hacks
%
% WARNING: use of these procedures is dangerous!
% Use them only as a last resort, only if performance is critical, and only if
% profiling shows that using the safe versions is a bottleneck.
%
% These procedures may vanish in some future version of Mercury.
% `unsafe_arg_ref' is the same as `arg_ref',
% and `unsafe_new_arg_ref' is the same as `new_arg_ref'
% except that they doesn't check for errors,
% and they don't work for `no_tag' types (types with
% exactly one functor which has exactly one argument),
% and they don't work for arguments which occupy a word with other
% arguments,
% and they don't work for types with >4 functors.
% If the argument number is out of range,
% or if the argument reference has the wrong type,
% or if the argument is a `no_tag' type,
% or if the argument uses a packed representation,
% then the behaviour is undefined, and probably harmful.
:- pred store.unsafe_arg_ref(generic_ref(T, S)::in, int::in,
generic_ref(ArgT, S)::out, S::di, S::uo) is det <= store(S).
:- pred store.unsafe_new_arg_ref(T::di, int::in, generic_ref(ArgT, S)::out,
S::di, S::uo) is det <= store(S).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module deconstruct.
:- import_module require.
:- instance store(store(S)) where [].
:- instance store(io.state) where [].
% The store type itself is just a dummy type,
% with no real representation.
:- type store(S).
:- pragma foreign_type("C", store(S), "MR_Word", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("IL", store(S), "int32", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("C#", store(S), "int", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("Java", store(S), "int", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("Erlang", store(S), "", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pred store_equal(store(S)::in, store(S)::in) is semidet.
store_equal(_, _) :-
error("attempt to unify two stores").
:- pred store_compare(comparison_result::uo, store(S)::in, store(S)::in)
is det.
store_compare(_, _, _) :-
error("attempt to compare two stores").
% Mutvars and references are each represented as a pointer to a single word
% on the heap.
:- type generic_mutvar(T, S) ---> mutvar(private_builtin.ref(T)).
:- type generic_ref(T, S) ---> ref(private_builtin.ref(T)).
store.init(S) :-
store.do_init(S).
:- some [S] pred store.do_init(store(S)::uo) is det.
:- pragma foreign_proc("C",
store.do_init(_S0::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
TypeInfo_for_S = 0;
").
:- pragma foreign_proc("C#",
store.do_init(_S0::uo),
[will_not_call_mercury, promise_pure],
"
TypeInfo_for_S = null;
").
:- pragma foreign_proc("Java",
store.do_init(_S0::uo),
[will_not_call_mercury, promise_pure],
"
TypeInfo_for_S = null;
").
:- pragma foreign_proc("Erlang",
store.do_init(_S0::uo),
[will_not_call_mercury, promise_pure],
"
TypeInfo_for_S = 'XXX'
").
% Note -- the syntax for the operations on stores
% might be nicer if we used some new operators, e.g.
%
% :- op(.., xfx, ('<-')).
% :- op(.., fy, ('!')).
% :- op(.., xfx, (':=')).
%
% Then we could do something like this:
%
% Ptr <- new(Val) --> new_mutvar(Val, Ptr).
% Val <- !Ptr --> get_mutvar(Ptr, Val).
% !Ptr := Val --> set_mutvar(Ptr, Val).
%
% I wonder whether it is worth it? Hmm, probably not.
:- pragma foreign_proc("C",
new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
MR_offset_incr_hp_msg(Mutvar, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
MR_ALLOC_ID, ""store.mutvar/2"");
MR_define_size_slot(0, Mutvar, 1);
* (MR_Word *) Mutvar = Val;
S = S0;
").
:- pragma foreign_proc("C",
get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
Val = * (MR_Word *) Mutvar;
S = S0;
").
:- pragma foreign_proc("C",
set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
* (MR_Word *) Mutvar = Val;
S = S0;
").
:- pragma foreign_type("C#", generic_mutvar(T, S), "object[]").
:- pragma foreign_proc("C#",
new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar = new object[] { Val };
").
:- pragma foreign_proc("C#",
get_mutvar(Mutvar::in, Val::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Val = Mutvar[0];
").
:- pragma foreign_proc("C#",
set_mutvar(Mutvar::in, Val::in, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar[0] = Val;
").
:- pragma foreign_type("Java", generic_mutvar(T, S), "mutvar.Mutvar").
:- pragma foreign_proc("Java",
new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar = new mutvar.Mutvar(Val);
").
:- pragma foreign_proc("Java",
get_mutvar(Mutvar::in, Val::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Val = Mutvar.object;
").
:- pragma foreign_proc("Java",
set_mutvar(Mutvar::in, Val::in, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar.object = Val;
").
% XXX ets are not garbage collected
% but shareable between processes
:- pragma foreign_type("Erlang", generic_mutvar(T, S), "").
:- pragma foreign_proc("Erlang",
new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar = ets:new(mutvar, [set, public]),
ets:insert(Mutvar, {value, Val}),
S = S0
").
:- pragma foreign_proc("Erlang",
get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
[{value, Val}] = ets:lookup(Mutvar, value),
S = S0
").
:- pragma foreign_proc("Erlang",
set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
ets:insert(Mutvar, {value, Val}),
S = S0
").
copy_mutvar(Mutvar, Copy, !S) :-
get_mutvar(Mutvar, Value, !S),
new_mutvar(Value, Copy, !S).
:- pred store.unsafe_new_uninitialized_mutvar(generic_mutvar(T, S)::out,
S::di, S::uo) is det <= store(S).
:- pragma foreign_proc("C",
unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
MR_offset_incr_hp_msg(Mutvar, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
MR_ALLOC_ID, ""store.mutvar/2"");
MR_define_size_slot(0, Mutvar, 1);
S = S0;
").
:- pragma foreign_proc("C#",
unsafe_new_uninitialized_mutvar(Mutvar::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar = new object[1];
").
:- pragma foreign_proc("Java",
unsafe_new_uninitialized_mutvar(Mutvar::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Mutvar = new mutvar.Mutvar();
").
store.new_cyclic_mutvar(Func, MutVar, !Store) :-
store.unsafe_new_uninitialized_mutvar(MutVar, !Store),
Value = apply(Func, MutVar),
store.set_mutvar(MutVar, Value, !Store).
%-----------------------------------------------------------------------------%
:- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
:- pragma foreign_code("C#",
"
public class Ref {
// Object referenced.
public object obj;
// Specific field of object referenced, or null to
// specify the object itself.
// XXX GetFields does not return fields in any particular order so
// this is not really usable.
public System.Reflection.FieldInfo field;
// Constructors
public Ref(object init) {
obj = init;
field = null;
}
public Ref(object init, int num) {
obj = init;
setField(num);
}
// Set the field according to a given index.
public void setField(int num) {
field = obj.GetType().GetFields()[num];
}
// Return the value of the reference.
public object getValue() {
if (field == null) {
return obj;
} else {
return field.GetValue(obj);
}
}
// Update the value of the reference.
public void setValue(object value) {
field.SetValue(obj, value);
}
} // class Ref
").
:- pragma foreign_type(java, generic_ref(T, S), "store.Ref").
:- pragma foreign_code("Java",
"
public static class Ref {
// Object referenced.
public java.lang.Object object;
// Specific field of object referenced, or null to
// specify the object itself.
// XXX getDeclaredFields does not return fields in any particular
// order so this is not really usable.
public java.lang.reflect.Field field;
// Constructors
public Ref(java.lang.Object init) {
object = init;
field = null;
}
public Ref(java.lang.Object init, int num) {
object = init;
setField(num);
}
// Set the field according to a given index.
public void setField(int num) {
try {
field = object.getClass().getDeclaredFields()[num];
} catch (java.lang.SecurityException se) {
throw new java.lang.RuntimeException(
""Security manager denied access to object fields"");
} catch (java.lang.ArrayIndexOutOfBoundsException e) {
throw new java.lang.RuntimeException(
""No such field in object"");
} catch (java.lang.Exception e) {
throw new java.lang.RuntimeException(
""Unable to set field: "" + e.getMessage());
}
}
// Return the value of the reference.
public java.lang.Object getValue() {
if (field == null) {
return object;
} else {
try {
return field.get(object);
} catch (java.lang.IllegalAccessException e) {
throw new java.lang.RuntimeException(
""Field inaccessible"");
} catch (java.lang.IllegalArgumentException e)
{
throw new java.lang.RuntimeException(
""Field-object mismatch"");
} catch (java.lang.NullPointerException e) {
throw new java.lang.RuntimeException(
""Object is null"");
} catch (java.lang.Exception e) {
throw new java.lang.RuntimeException(
""Unable to access field: "" + e.getMessage());
}
}
}
// Update the value of the reference.
public void setValue(java.lang.Object value) {
try {
field.set(object, value);
} catch (java.lang.IllegalAccessException e) {
throw new java.lang.RuntimeException(""Field inaccessible"");
} catch (java.lang.IllegalArgumentException e) {
throw new java.lang.RuntimeException(
""Field-object mismatch"");
} catch (java.lang.NullPointerException e) {
throw new java.lang.RuntimeException(""Object is null"");
} catch (java.lang.Exception e) {
throw new java.lang.RuntimeException(
""Unable to access field: "" + e.getMessage());
}
}
} // class Ref
").
:- pragma foreign_proc("C",
new_ref(Val::di, Ref::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
MR_ALLOC_ID, ""store.ref/2"");
MR_define_size_slot(0, Ref, 1);
* (MR_Word *) Ref = Val;
S = S0;
").
:- pragma foreign_proc("C#",
new_ref(Val::di, Ref::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Ref = new store.Ref(Val);
").
:- pragma foreign_proc("Java",
new_ref(Val::di, Ref::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Ref = new store.Ref(Val);
").
:- pragma foreign_proc("Erlang",
new_ref(Val::di, Ref::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
Ref = ets:new(mutvar, [set, public]),
ets:insert(Ref, {value, Val}),
S = S0
").
copy_ref_value(Ref, Val) -->
% XXX Need to deep-copy non-atomic types.
unsafe_ref_value(Ref, Val).
% Unsafe_ref_value extracts the value that a reference refers to, without
% making a copy; it is unsafe because the store could later be modified,
% changing the returned value.
%
:- pred store.unsafe_ref_value(generic_ref(T, S)::in, T::uo,
S::di, S::uo) is det <= store(S).
:- pragma foreign_proc("C",
unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
[will_not_call_mercury, promise_pure, will_not_modify_trail],
"
Val = * (MR_Word *) Ref;
S = S0;
").
:- pragma foreign_proc("C#",
unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Val = Ref.getValue();
").
:- pragma foreign_proc("Java",
unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Val = Ref.getValue();
").
:- pragma foreign_proc("Erlang",
unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
[{value, Val}] = ets:lookup(Ref, value),
S = S0
").
ref_functor(Ref, Functor, Arity, !Store) :-
unsafe_ref_value(Ref, Val, !Store),
functor(Val, canonicalize, Functor, Arity).
:- pragma foreign_decl("C",
"
#include ""mercury_type_info.h""
#include ""mercury_heap.h""
#include ""mercury_misc.h"" /* for MR_fatal_error() */
#include ""mercury_deconstruct.h"" /* for MR_arg() */
").
:- pragma foreign_proc("C",
arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, may_not_duplicate],
"{
MR_TypeInfo type_info;
MR_TypeInfo arg_type_info;
MR_TypeInfo exp_arg_type_info;
MR_Word *arg_ref;
const MR_DuArgLocn *arg_locn;
type_info = (MR_TypeInfo) TypeInfo_for_T;
exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;
MR_save_transient_registers();
if (!MR_arg(type_info, (MR_Word *) Ref, ArgNum, &arg_type_info,
&arg_ref, &arg_locn, MR_NONCANON_ABORT))
{
MR_fatal_error(""store.arg_ref: argument number out of range"");
}
if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
MR_COMPARE_EQUAL)
{
MR_fatal_error(""store.arg_ref: argument has wrong type"");
}
MR_restore_transient_registers();
if (arg_locn != NULL && arg_locn->MR_arg_bits != 0) {
MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
MR_define_size_slot(0, ArgRef, 1);
* (MR_Word *) ArgRef = MR_arg_value(arg_ref, arg_locn);
} else {
ArgRef = (MR_Word) arg_ref;
}
S = S0;
}").
:- pragma foreign_proc("C#",
arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
/*
** XXX Some dynamic type-checking should be done here to check that
** the type of the specified Arg matches the type supplied by the caller.
** This will require RTTI.
*/
ArgRef = new store.Ref(Ref.getValue(), ArgNum);
").
:- pragma foreign_proc("Java",
arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
/*
** XXX Some dynamic type-checking should be done here to check that
** the type of the specified Arg matches the type supplied by the caller.
** This will require RTTI.
*/
ArgRef = new store.Ref(Ref.getValue(), ArgNum);
").
:- pragma foreign_proc("C",
new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure, may_not_duplicate],
"{
MR_TypeInfo type_info;
MR_TypeInfo arg_type_info;
MR_TypeInfo exp_arg_type_info;
MR_Word *arg_ref;
const MR_DuArgLocn *arg_locn;
type_info = (MR_TypeInfo) TypeInfo_for_T;
exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;
MR_save_transient_registers();
if (!MR_arg(type_info, (MR_Word *) &Val, ArgNum, &arg_type_info,
&arg_ref, &arg_locn, MR_NONCANON_ABORT))
{
MR_fatal_error(""store.new_arg_ref: argument number out of range"");
}
if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
MR_COMPARE_EQUAL)
{
MR_fatal_error(""store.new_arg_ref: argument has wrong type"");
}
MR_restore_transient_registers();
if (arg_locn != NULL && arg_locn->MR_arg_bits != 0) {
MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
MR_define_size_slot(0, ArgRef, 1);
* (MR_Word *) ArgRef = MR_arg_value(arg_ref, arg_locn);
} else if (arg_ref == &Val) {
/*
** For no_tag types, the argument may have the same address as the
** term. Since the term (Val) is currently on the C stack, we can't
** return a pointer to it; so if that is the case, then we need
** to copy it to the heap before returning.
*/
MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
MR_define_size_slot(0, ArgRef, 1);
* (MR_Word *) ArgRef = Val;
} else {
ArgRef = (MR_Word) arg_ref;
}
S = S0;
}").
:- pragma foreign_proc("C#",
new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
/*
** XXX Some dynamic type-checking should be done here to check that
** the type of the specified Arg matches the type supplied by the caller.
** This will require RTTI.
*/
ArgRef = new store.Ref(Val, ArgNum);
").
:- pragma foreign_proc("Java",
new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
/*
** XXX Some dynamic type-checking should be done here to check that
** the type of the specified Arg matches the type supplied by the caller.
** This will require RTTI.
*/
ArgRef = new store.Ref(Val, ArgNum);
").
:- pragma foreign_proc("C",
set_ref(Ref::in, ValRef::in, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
* (MR_Word *) Ref = * (MR_Word *) ValRef;
S = S0;
").
:- pragma foreign_proc("C#",
set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Ref.setValue(ValRef.getValue());
").
:- pragma foreign_proc("Java",
set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Ref.setValue(ValRef.getValue());
").
:- pragma foreign_proc("C",
set_ref_value(Ref::in, Val::di, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"
* (MR_Word *) Ref = Val;
S = S0;
").
:- pragma foreign_proc("Java",
set_ref_value(Ref::in, Val::di, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
Ref.setValue(Val);
").
:- pragma foreign_proc("C",
extract_ref_value(_S::di, Ref::in, Val::out),
[will_not_call_mercury, promise_pure],
"
Val = * (MR_Word *) Ref;
").
:- pragma foreign_proc("C#",
extract_ref_value(_S::di, Ref::in, Val::out),
[will_not_call_mercury, promise_pure],
"
Val = Ref.getValue();
").
:- pragma foreign_proc("Java",
extract_ref_value(_S::di, Ref::in, Val::out),
[will_not_call_mercury, promise_pure],
"
Val = Ref.getValue();
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
MR_Word *Ptr;
Ptr = (MR_Word *) MR_strip_tag((MR_Word) Ref);
ArgRef = (MR_Word) &Ptr[Arg];
S = S0;
}").
:- pragma foreign_proc("C#",
unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
ArgRef = new store.Ref(Ref.getValue(), Arg);
").
:- pragma foreign_proc("Java",
unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
ArgRef = new store.Ref(Ref.getValue(), Arg);
").
:- pragma foreign_proc("C",
unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, S0::di, S::uo),
[will_not_call_mercury, promise_pure],
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
MR_Word *Ptr;
Ptr = (MR_Word *) MR_strip_tag((MR_Word) Val);
ArgRef = (MR_Word) &Ptr[Arg];
S = S0;
}").
:- pragma foreign_proc("C#",
unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
ArgRef = new store.Ref(Val, Arg);
").
:- pragma foreign_proc("Java",
unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
"
ArgRef = new store.Ref(Val, Arg);
").

5
samples/Moocode/hello.moo Normal file
View File

@@ -0,0 +1,5 @@
@program toy:wind
this.wound = this.wound + 2;
player:tell("You wind up the ", this.name,".");
player.location:announce(player.name, " winds up the ", this.name,".");
.

19
samples/Moocode/toy.moo Normal file
View File

@@ -0,0 +1,19 @@
@verb toy:do_the_work this none this
@program toy:do_the_work
if (this.wound)
if ($object_utils:isa(this.location,$room))
this.location:announce_all(this.name," ", this:continue_msg());
this.wound = this.wound - 1;
if (this.wound)
fork (15)
this:do_the_work();
endfork
else
this.location:announce_all(this.name, " ", this:wind_down_msg());
endif
endif
if (this.wound < 0)
this.wound = 0;
endif
endif
.