<haakonn_>
which just says what the type is, and how to compare elements of that type
<salo>
is there one of those built in for the int type?
<kinners>
no
<haakonn_>
but i'm sure you can reuse a compare function for ints
<salo>
module OrderedInt =
<salo>
struct
<salo>
type t = int
<salo>
let compare x y = compare x y
<salo>
end;;
<salo>
right?
<kinners>
yes, let compare = compare also works
<salo>
module IntSet = Set.Make(OrderedInt);;
<salo>
so that gets me the module i want, but i don't quite understand how i now get an instance of IntSet
<kinners>
you can start off with IntSet.empty
<haakonn_>
or IntSet.singleton for a singleton set
<kinners>
or singleton, then just build up the set from there
<salo>
gotcha! thank you!
<kinners>
I'm not sure if you have to constrain the type of the compare function so that ocaml can do a simple int compare instead of calling the polymorphic compare function
salo has quit []
GreyLensman has joined #ocaml
CosmicRay has joined #ocaml
monochrom has quit ["Don't talk to those who talk to themselves."]
kinners has quit [Read error: 110 (Connection timed out)]
CosmicRay has quit ["Leaving"]
cjohnson has quit [Read error: 104 (Connection reset by peer)]
cjohnson has joined #ocaml
cjohnson has quit ["The main attraction: distraction"]
GreyLensman has quit [Read error: 110 (Connection timed out)]
budjet has joined #ocaml
budjet has quit [Remote closed the connection]
salo has joined #ocaml
<salo>
let listOf f n =
<salo>
let rec builder i l =
<salo>
if i = 0
<salo>
then l
<salo>
else builder (i - 1) (f i)::l
<salo>
in
<salo>
builder n [];;
<salo>
can someone tell me my error?
<avlondono>
((f i)::l) seems the only possible "error" to me
<salo>
that fixed it! thanks!
<avlondono>
you're welcome
<salo>
bonus points: is it possible to write down an anonymous function in ocaml?
<avlondono>
fun x -> x + 1
<salo>
you win the trip to the bahamas, thanks for playing
<avlondono>
hehehe
Blicero has joined #ocaml
ez4 has quit ["Quitting!"]
Herrchen has joined #ocaml
srv has quit [Read error: 232 (Connection reset by peer)]
srv has joined #ocaml
vezenchio has joined #ocaml
mlh has quit [Client Quit]
pango has quit ["Client exiting"]
<async>
/join #subversion
pango has joined #ocaml
m3ga has joined #ocaml
mlh has joined #ocaml
<m3ga>
hey matt
m3ga has quit ["Client exiting"]
velco has joined #ocaml
<velco>
where's the ocamlopt ?
<velco>
IOW, why it didn;t get installed/built in 3.08.1 ?
gl has quit [Read error: 110 (Connection timed out)]
avlondon1 has joined #ocaml
avlondono has quit [Read error: 104 (Connection reset by peer)]
allemann454 has joined #ocaml
allemann454 has left #ocaml []
cmeme has quit [Read error: 110 (Connection timed out)]
cmeme has joined #ocaml
salo has quit []
kinners has joined #ocaml
gl has joined #ocaml
oracle1_ has joined #ocaml
Niccolo has quit [Read error: 110 (Connection timed out)]
oracle1 has quit [Read error: 110 (Connection timed out)]
<velco>
why ocamlopt didn't get installed/built in 3.08.1 ?
<velco>
ok, nevermind ..
<velco>
"When all else fails, read the documentation ..."
cjohnson has joined #ocaml
salo has joined #ocaml
avlondon1 has quit ["leaving"]
salo has quit []
johgro has joined #ocaml
skylan_ has joined #ocaml
kinners has quit ["leaving"]
skylan has quit [Read error: 110 (Connection timed out)]
johgro has quit [Remote closed the connection]
gl has quit [Read error: 110 (Connection timed out)]
salo has joined #ocaml
Smerdyakov has quit [zelazny.freenode.net irc.freenode.net]
judge has quit [zelazny.freenode.net irc.freenode.net]
Smerdyakov has joined #ocaml
judge has joined #ocaml
Niccolo has joined #ocaml
mlh has quit [Client Quit]
_fab has joined #ocaml
salo has quit []
gl has joined #ocaml
velco has quit ["Client exiting"]
_fab has quit []
allemann454 has joined #ocaml
allemann454 has left #ocaml []
_fab has joined #ocaml
<vincenz>
Should I use <> or !=?
<vincenz>
(aka which one is the one matching to =)
Niccolo has quit [Remote closed the connection]
Niccolo has joined #ocaml
<mellum>
<>
<haakonn_>
what is the difference? they seem to give the same results.
docelic has quit ["brb"]
salo has joined #ocaml
<vincenz>
structural vs pointer comparison
<vincenz>
let a = "abc" in let b = "abc" in a = b -> true
<vincenz>
let a = "abc" in let b = "abc" in a == b -> false
<vincenz>
let a = "abc" in let b = a in a == b -> true
<vincenz>
and of course not = <-> <>
<vincenz>
not == <-> !=
<haakonn_>
i see
<Smerdyakov>
Some of us believe that == has no place in a language. :)
<haakonn_>
yeah, i can't imagine when you'd want to test for pointer equivalence :)
docelic has joined #ocaml
<vincenz>
What's a labelized version?
<vincenz>
(List Array, String)
<vincenz>
Like....what's the difference between List and ListLabels?
<vincenz>
haakonn_: recursive structures?
<haakonn_>
hm
<vincenz>
18:46 < haakonn_> yeah, i can't imagine when you'd want to test for pointer
<vincenz>
equivalence :)
<haakonn_>
why would you need to compare references in a recursive structure?
<Smerdyakov>
vincenz, why don't you look at their signatures and see?
cjohnson has quit [Read error: 113 (No route to host)]
cjohnson has joined #ocaml
<vincenz>
hmm
<vincenz>
also on another note, how does Printf not break typing?
<vincenz>
is it because the strings must be manifest?
pango has quit ["Leaving"]
pango has joined #ocaml
<Smerdyakov>
Printf uses a special hack built into the compiler.
<Smerdyakov>
The format strings must always be constants, yes.
<pango>
vincenz: first parameter of Printf.printf isn't a string
<vincenz>
pango: it's written as a string though
* vincenz
nods
<vincenz>
but I get it, it's a compiler hack :)
<vincenz>
anyways, making it manifest doesn't limit possibilities
<vincenz>
you can always do Printf.printf "%s"
<pango>
# let s = "%s\n" in Printf.printf s "Hello, world!" ;;
<pango>
This expression has type string but is here used with type
<pango>
('a -> 'b, out_channel, unit) format =
<pango>
('a -> 'b, out_channel, unit, unit) format4
<haakonn_>
"This expression has type Lexing.lexbuf -> Parser.token but is here used with type Lexing.lexbuf -> token" -- Parser.token _is_ token! the same type ... how to solve?
<vincenz>
I really wish they updated it to do ocaml syntax coloring (someone have an enscript script for ocaml?)
<vincenz>
most websites with coloring use the enscript utility
<haakonn_>
vincenz: it's my own code from a mly file (ocamlyacc) named parser.mly, so it's within the Parser module
<vincenz>
haakonn_: usually in your lexer you do "import Parser"
<vincenz>
make that 'open Parser"
<haakonn_>
but this doesn't concern the lexer
<haakonn_>
and in my lexer i do have 'open Parser'
<vincenz>
haakonn_: you'll have to paste your code, I can't help you with an error if I don't see where it's happening
<haakonn_>
from parser.mly (the last section): 'let parse_declaration filename = let buf = push_file filename in decl Lexer.main buf'. here 'decl' is a parser function/rule. the expression that triggers the error is 'Lexer.main', the lexer function.
<vincenz>
of course that won't work
<vincenz>
you have a recursive dependence
<vincenz>
lexer always depends on parser
<vincenz>
but now you're making parser depend on lexer
<vincenz>
you want to put that main in a separate file (I usually tend to call it driver.ml)
<haakonn_>
hm, good point
<haakonn_>
i solved it by making the lexer an argument to the function instead :)
<salo>
anyone have experience building the ocaml native compiler on mips/irix, or perhaps any other 64b machine?
<Smerdyakov>
pango, that is ugly!!
<vincenz>
yah
<vincenz>
haakonn_: it's good practice to put your main in a separate ml and not in the parser
<haakonn_>
vincenz: my "main" is already in main.ml, i just need some additional logic in the parser
monochrom has joined #ocaml
<vincenz>
oh
<vincenz>
that should still go in your main..
<haakonn_>
but it's inherent to the parser. the "client" doesn't have to know about it at all
<vincenz>
hmmkay
<vincenz>
what are you parsing?
<haakonn_>
just a simple language, but it allows to include other files that make up parts of the complete program, and for this, i need some logic (a stack etc)
<vincenz>
what's the language do?
<haakonn_>
it describes how software components use each other (completely academic)
<vincenz>
interesting
<vincenz>
what do you do?
* vincenz
is in the academic world as well
<haakonn_>
it's my master's project
<vincenz>
got a link?
<haakonn_>
hm, no
<vincenz>
and what's the purpose of your project?
<Smerdyakov>
I like software components.
<haakonn_>
mainly to implement a type inference system for the specification language, that allows you to see instantly the number of instances a component configuration will lead to
<vincenz>
I'll talk later, gotta catch my bus home
<haakonn_>
see you :)
<Smerdyakov>
haakonn_ is a mysterious Norwegian!
<haakonn_>
i don't know about mysterious :)
<Smerdyakov>
Would you like to come get a PhD in the USA? :)
<haakonn_>
that would be interesting
<Smerdyakov>
PhD students have a nicer time in the USA than Europe.
<haakonn_>
how so?
<Smerdyakov>
Well, as a student, my stipend gives me more income than most teachers, for instance.
<haakonn_>
wow
<mflux>
how about after you pay tuition?
<Smerdyakov>
(Not university teachers, but teachers for high school or whatever you call it there.)
<haakonn_>
i see
<Smerdyakov>
mflux, tuition and fees are all handled separately.
<salo>
smerdyakov: i don't think that is universally true, and i think it is decreasingly true in my experience
<Smerdyakov>
salo, I know, but it's true for the _best_ people. ;)
<Smerdyakov>
haakonn_, also, in the USA you can take 8 years to get the PhD and no one will think it's so bad, in my cases. :)
<Smerdyakov>
er, in _many_ cases
<haakonn_>
wow, paradise :)
<haakonn_>
the norwegian system just wants to churn you through the system ASAP
<salo>
i think european and asian universities are on their way to surpass NA universities
<salo>
at least in science and engineering
<Smerdyakov>
salo, it all depends on how much funding their governments are willing to put into it.
<Smerdyakov>
salo, the US system is dominant because of military funding.
* Smerdyakov
runs away.
<salo>
it seems that in the US that universities are a decreasing priority
* Smerdyakov
runs back!
<Smerdyakov>
You are perhaps confusing undergraduate education and research.
<Smerdyakov>
Research is a priority.
<Smerdyakov>
Or, at least, research has certainly been a priority in the recent past, when the US system has dominated.
<Smerdyakov>
It could change.
* Smerdyakov
runs away.
<salo>
it seems that emphasis is decreasing tho. for example, in 2003, china published more physics research than the US
salo has quit []
<haakonn_>
argh. ocamlyacc rules cannot be recursive? so in a rule 'foo' you cannot call the function foo. hmf
<mflux>
I haven't used nor inspected it, but that would seem strange
<mflux>
how is one supposed to construct a list otherwise?
<mflux>
or are you talking about something else ;)
<haakonn_>
i'm not constructing lists :)
allemann454 has joined #ocaml
haakonn_ is now known as haakonn
<Smerdyakov>
haakonn, it's rather abnormal to call terminal functions manually instead of using the production syntax. Why do you want to do it?
<haakonn>
Smerdyakov: it has to do with the language's support for inclusion of other program files, but i suppose i have to find a more elegant solution
<vincenz>
Smerdyakov: that's bs, I'm a PhD student and I earn quite well too
<vincenz>
more than a highschool teacher
<vincenz>
anyways I gotta reboot to windows
<vincenz>
gotta copy some cd's for my chinese course (which linux won't read :/ )
vincenz has quit ["leaving"]
allemann454 has left #ocaml []
async has quit ["leaving"]
tea has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]
Blicero has quit [Read error: 104 (Connection reset by peer)]
Demitar has joined #ocaml
tea has quit ["using sirc version 2.211+KSIRC/1.3.10"]
Herrchen has quit ["bye"]
ez4 has joined #ocaml
vezenchio has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
salo has joined #ocaml
<salo>
List.filter (fun (_,n) when n <= 2 ->true | _ ->false) l;;
<salo>
whats wrong with this?
<monochrom>
you can say "when"?
<Smerdyakov>
Only 'function,' not 'fun,' supports multiple cases.
<salo>
guard condition. maybe you can't have them in anonymous functions?
<salo>
ah
<salo>
i thought fun was just a short form for function
<monochrom>
Actually, it seems to be allowed.
<monochrom>
Ah, | _ -> false is not allowed.
<monochrom>
fun (_,n) when n <= 2 ->true this is alright
<Smerdyakov>
Not _too_ all right, though, since it will raise an exception in most cases....
<monochrom>
Yeah, the compiler whines about "bad taste" etc.
zigong__ has quit ["Leaving"]
shulik_ has joined #ocaml
salo has left #ocaml []
shulik_ has left #ocaml []
Hadaka has quit [No route to host]
vincenz has joined #ocaml
GreyLensman has joined #ocaml
kinners has joined #ocaml
skylan_ is now known as skylan
monochrom has quit ["Don't talk to those who talk to themselves."]