<Nutssh>
Interesting. I liked the regexp curry example.
<pattern>
can it be done without named arguments?
<pattern>
obviously it can if you partial evaluate from left to right, leaving off the right most argument(s)
<pattern>
but if you want to do this in an arbitrary order you are required to name each argument?
<liralen>
you can use combinators.
<pattern>
ahh... too advanced for me :)
gim has joined #ocaml
<liralen>
let flip f x y = f y x;;
<liralen>
flip (-) 4;;
<pattern>
ahh... interesting
<pattern>
here is something i'm confused about: let rec foo f x = f ( foo f ) x
<pattern>
how do figure out the type of foo? (apart from asking the ocaml toplevel :)
<Nutssh>
You do unification of constraints.
<pattern>
ok, so i start from the most general types, right?
<pattern>
give each argument a sperate type, like 'a 'b, etc...?
<pattern>
and then get infer more specific types based on what i see constraining the arugment?
<pattern>
it all sounds fine on paper, but when i start, i get confused (at least with this function)
<pattern>
like f must be a function, obviously, but what is x? it an argument to f, from "f ( foo f )"
<pattern>
so it must be a function ("foo", in this case) that takes a function as its first argument ("f")
<pattern>
but what does it return?
<pattern>
i can also surmise that once f is applied to "( foo f )" it returns a function, because it is then applied to x
<Nutssh>
Yes.
<pattern>
but that's about as far as i can get without my head spinning
<Nutssh>
Assign a general type 'a 'b 'c 'd to all arguments.. For instance:
<Nutssh>
f x = x * 2 ---> f: 'a -> 'b x : 'c * : int * int -> int
<Nutssh>
Now set up a type equation We know that since the argument to * must be int and int, 'c = int and 2 = int. Since the argument to f is x, 'a = 'c . Since the output of the product is :int , 'b = int.
<Nutssh>
You try to type let flip f x y = f y x
<pattern>
hmmm... let rec (foo: 'a -> 'b) (x:'c) ?
<pattern>
ok
<Nutssh>
Try flip before doing your function.
<pattern>
let (flip: 'a -> 'b) (x: 'c) (y: 'd)
<Nutssh>
Well, flip takes three arguments. And what are the type equations?
<pattern>
oh, right
<pattern>
let (flip: 'a -> 'b -> 'c)
<pattern>
(x: 'a) (y: 'b), right?
<pattern>
and then x and y must both be 'a
<pattern>
because they can substitute for either argument
<pattern>
oops
<pattern>
wait
<pattern>
i just completely ignored f
<pattern>
let's try this again
<Nutssh>
Yeah. :)
<pattern>
let (flip: 'a -> 'b -> 'c -> 'd )
<Nutssh>
No, show the types then show the equations. *THEN* solve them.
<pattern>
oh
<pattern>
so you mean start with the arguments?
<Nutssh>
Go like:
<Nutssh>
flip : A -> B -> C -> D
<Nutssh>
x: E
Nutssh has quit ["Client exiting"]
Nutssh has joined #ocaml
<Nutssh>
Scratch that. Can you past back my last line?
<Nutssh>
(Last couple of lines)
<pattern>
<Nutssh> Go like:
<pattern>
<Nutssh> flip : A -> B -> C -> D
<pattern>
<Nutssh> x: E
<Nutssh>
y : F (I'm using capital letters to indicate type variables rather than use "'")
<Nutssh>
y : F
<Nutssh>
f : G
<pattern>
why is f G and not E?
<pattern>
or does it not matter?
<Nutssh>
Doesn't matter.
<pattern>
ok
<Nutssh>
Now form the equations From the fact that f is the first argument to flip, we have ??
<pattern>
f must be A
<Nutssh>
No. We have the equation G=A
<pattern>
ok
<Nutssh>
How about for the other two arguments for flip?
<pattern>
E=B F=C
<Nutssh>
Yup.
<pattern>
cool :)
<Nutssh>
Now from the fact that f is applied two two things and returns a third thing we get what equation?
<Nutssh>
(You'll need to create new variables for this.)
<pattern>
A = B -> C -> D
<Nutssh>
No. Because this couldl capture type variables used earlier, like the ones used in the declaration of flip. Must create new ones.
<pattern>
A = H -> I -> J
<Nutssh>
And, you're solving the equation A=G, don't. Just write down the equation.
<pattern>
i don't understand what you're asking
<Nutssh>
Don't use the fact that A=G. Its just G= H->I->J
<pattern>
oh
<pattern>
but what happened to A=G?
<Nutssh>
You save it around. *after* getting all of the equations together, we solve them.
<pattern>
i see
<pattern>
but if A=G then why can't i reuse B, C, and D in A (or G) = B -> C -> D ?
<pattern>
wasn't i reusing A (or G) in A=G?
<Nutssh>
given that F is applied to x and y, what can we infer about equalities of the type of the expression (f) used in the program (H,I,J) and the types of the arguments x: E, y: F ?
<Nutssh>
Don't reuse. It'll lead to a ball of mud because you have to worry about capture.
<pattern>
but isn't A=G reuse?
<Nutssh>
No, it is an equation stating that two type variables are now equal to each other.
<pattern>
but isn't that what G=A->B->C does as well?
<Nutssh>
You solve the problem by assigning types to expressions, then constructing a set of equations representing constraints. Like you did with G = H->I->J. Then as a last stage, solve them.
<Nutssh>
Yes. It to is another equation.
<pattern>
oh
<mellum>
Hey, it's a NP-complete problem, you cannot solve it efficiently anyway, so why bother? ;)
<Nutssh>
mellum: For a simple type system without polymorphism or subtyping, it is a linear problem.
<pattern>
i wasn't trying to reuse A, B, and C for efficiency, i just didn't understand why A=G was allowed reuse, while G=A->B->C wasn't and i had to to G=H->I->J
<Nutssh>
A=G is not reuse. It is a constraint linking the type of the first argument of 'flip' to the name 'f'.
<Nutssh>
Err, to the type of the name 'f'.
<Nutssh>
Err, to the type of the binding 'f'.
<pattern>
ok, i'll just take in on faith :)
<pattern>
so, back to f
<pattern>
x must be H
<Nutssh>
Anyways, What are the current type rules and type equations?
<pattern>
and y must be I
<pattern>
right?
<Nutssh>
No. type equations deal with types.
<pattern>
let flip f x y = f y x
<pattern>
flip: A -> B -> C -> D
<pattern>
x: E
<pattern>
y: F
<pattern>
f: G
<pattern>
A=G
<pattern>
G=H->I->J
<pattern>
E=H
<pattern>
F=I
<pattern>
no?
<liralen>
(no variable 'reuse': if x=1+2 and x=b, then b=3)
<Nutssh>
Yup! :)
<Nutssh>
But you need too more. B&C = ?
<Nutssh>
Err, three more. D too.
<pattern>
B=E
cDlm has joined #ocaml
<pattern>
C=F
<pattern>
D=J
<Nutssh>
Yup. Now solve these, and get? :)
<pattern>
gimme a sec...
<Nutssh>
Since each equation has a single variable on the left (and always does) its best just to blindly substitute out all occurances of those variables.)
<pattern>
flip: ( H -> I -> J ) -> E -> F -> J
<pattern>
or something
<liralen>
pattern - that doesn't seem very useful, though -- particularly since it throws away the information you have about E=I and F=J
<Nutssh>
Almost. There's the equations for H & I left. (Oh, sorry, I didn't catch them -- you made a minor mistake H=F, I=E
<pattern>
oh
<Nutssh>
From A=G and H=..., replace A=G with A=H->I->J by blind substituting the left hand side for the right everywhere, then remove the rule because you've substituted out all uses of it.
<pattern>
wait, why does H=F?
<pattern>
i thought E=H
<liralen>
(if 1+2=b and 2=1+1, then b=1+1+1)
<pattern>
yes
<Nutssh>
liralen: We are disccussing type equations. Thats irrelevant.
<Nutssh>
Note that the definition of flip swaps the argument order. The first argument to 'f' :H is y:F.
<pattern>
ahh
<pattern>
so when i say H=F i am equating H, which is on the right side of the equation to F, which is on the left
<pattern>
i was getting kind of confused by that
<Nutssh>
Anyways, if you do the substitution. (And how to do it is do the substitution everywhere (including in the definitions of type for variables like 'f' 'x' 'y' 'flip'), then remove the type equation. when you have no equations left, you're done.)
<Nutssh>
Yes. It means that the two are constrained to be *equal*. So that the type variable H is equivalent to F, everywhere. Just like G=H->I->J constrains the two to be equal.
<pattern>
so i think i understand what you meant by reuse, now
<pattern>
A=G is just an equivalency of A, which is on the left side of the equation with G, which is on the right, not a reuse of A
<Nutssh>
Yeah. Reusing a variable is bad.
<Nutssh>
Yes. You have it.
<pattern>
whereas G=A->B->C would not be an equivalency, but a reuse
<Nutssh>
It depends.. What you're doing is eagerly solving the equations G=X and X= A->B->C
<Nutssh>
Its not incorrect, and ocaml does run that way, but it makes it hard to explain whats going on. So I'm explaining it as two stages. build equations, solve equations.
<pattern>
ok
<pattern>
flip: ( F -> E -> D ) E -> F -> D
<pattern>
how's that?
<Nutssh>
Yup.
<pattern>
what a pain in the ass!!!!
<liralen>
Except that that lies.
<pattern>
but thanks for sticking through this with me!
wazze has joined #ocaml
<pattern>
i know this must hurt you more than it hurts me
<Nutssh>
Oh, one more rule when solving equations, if you get 'A->B' = 'C->D', break it up into two equations 'A=C' and 'B=D'.
<pattern>
hmmm
<liralen>
oh, but nevermind, I misread it.
<Nutssh>
Heh. I'm forcing you to do it the nasty way, but it shoows what is going on and computers are better at it anyways.
<Nutssh>
I'm happy to explain to someone who wants to learn. Want to take a stab at your other problem now?
<pattern>
so what about "let rec foo f x = f ( foo f ) x" ? is there no better way than to go through this all again?
<pattern>
and for more complex equations?
<Nutssh>
Its not so bad to go through. :) Youo'll probably breeze through it now that you have a better idea what to do.
<pattern>
i'll definitely have an easier time of it, that's true
<Nutssh>
(But me forcing you to show all the equations without eagerly solving them will make it more annoying than it'd be otherwise)
<pattern>
let rec foo f x = f ( foo f ) x
<pattern>
foo: A -> B -> C
<pattern>
f: D
<pattern>
foo: E
<pattern>
x: G
<pattern>
C=B
<Nutssh>
Whoa? C=B?
<Nutssh>
Also, to help you a bit, you might want to write a type rule for every subexpression.
<pattern>
ah
<Nutssh>
(foo f): H
<pattern>
cool
<pattern>
that does make more sense
<Nutssh>
Thats the idea. :)
<pattern>
what about for "f (foo f)"? is that considered another subexpression deserving its own type?
<Nutssh>
You could, f: X->Y f (foo f): Y (f (foo f)) x: Z x:Q Y=Q->Z
<Nutssh>
Thats *technically* the right way to do it, because we're currying. But I'd ignore the grotty details of currying and not do that.
<pattern>
why not?
<Nutssh>
Simplicity for this example. Its extra complelxity that if its not needed will get in the way.
<pattern>
but (foo f) should have its own type, in this example?
<Nutssh>
Yes. Because it is a subexpression. When doing the type of f: X->Y->Z, want to have some expression :W so we can say Y=W.
<pattern>
let rec foo f x = f ( foo f ) x
<pattern>
foo: A -> B -> C
<pattern>
f: D
<pattern>
foo: E
<pattern>
x: G
<pattern>
(foo f): H
<pattern>
E=D->H
<pattern>
am i on the right track?
<Nutssh>
Remember that currying let rec foo a b = foo b a really means foo: X->Y a:A (foo b): W W=A->Q IE, (foo b) is a legitimate subexpression, so should get a seperate type variable and all that. Since we're fully invoking the curried function, I'm treating it as a multiargument invocation rather than as an incrementally curried function in this example and in yours.
<Nutssh>
Yes.
<pattern>
D=H->G->I ?
<Nutssh>
You need a few more equations though. Yup.
<Nutssh>
Oops. I misnoticed. you made a mistake on foo. it takes 3 arguments, not two.
<pattern>
it does?
<Nutssh>
But you got the right idea so far.
<pattern>
how does it take 3 arguments? i only see f and x
<Nutssh>
Oh duh. :) My mistake.
<Nutssh>
Youo're right. :)
<pattern>
cool :)
<pattern>
was afraid i'd have to start over :)
<Nutssh>
:)
<pattern>
so do i need more equations? or can i solve with what i have?
<Nutssh>
Need more. Need to deal with A,B,C
<pattern>
oh yeah
<pattern>
A=D, B=G, C=I
<Nutssh>
Yup. I *think* that that should be it. And the solution is?
<pattern>
foo: ( H -> G -> I ) -> G -> I
<Nutssh>
Almost, We missed an equation.
<pattern>
h?
<pattern>
i mean H?
<Nutssh>
Yeah. I'm trying to find it.
<pattern>
you want me to paste what i have so far?
<Nutssh>
No. I can see the equation OK.
Swynndla has quit ["Leaving"]
<Nutssh>
Ah. Thats it. The recursive call on foo.
<pattern>
yep
<pattern>
the recursive mindfuck call
<Nutssh>
Or rather, the curried call on foo.
<Nutssh>
:)
<Nutssh>
Do you want to take a stab at that?
* pattern
quakes in his boots
<Nutssh>
:)
<pattern>
only if i can type for infinity
<pattern>
well, it's a partial application
<pattern>
that much i know
<pattern>
so i don't really need to type for infinity
<Nutssh>
Even if it wasn't a partial applilcation, you wouldn't need to type to infinity.
<pattern>
well, i'm kind of confused anyway... H=D->H ?
<pattern>
or H=D->D ?
<pattern>
which means H=D?
ott has quit [Remote closed the connection]
<Nutssh>
We know: foo:A->X and X=B->C and (foo f) : H so H=X My error, we do have to treat the currying specifically.
<Nutssh>
Err.
<Nutssh>
No, thats right.
<pattern>
ok, at least i'm not the only one confused :)
<Nutssh>
No. I have it. :)
karryall has joined #ocaml
<pattern>
i understand how foo can be A->X and X=B->C and (foo f) we already said was H, but how do you get to H=X?
<Nutssh>
We also happen to get a second equation from that. H=X and A=D (but the second one is a dup.
<Nutssh>
Because foo is of type A->X, its output is X. We also know from the syntatic assignment of types to subexpressions that (foo f):H
<Nutssh>
Thus (foo f):X and (foo f):H so H=X.
<pattern>
hmm
<pattern>
i don't see how (foo f) is X
<pattern>
foo is A->X, yes
<Nutssh>
Look at the type of foo.. :)
<pattern>
but (foo f) is not just foo
<Nutssh>
No. (foo f) puts out two constraints. H=X and A=D
<Nutssh>
s/No. //.
<Nutssh>
Just trust me. this works out. :)
<pattern>
oh, i now see that in (foo f) f is analogous to A in foo:A->X, so that's why (foo f):X
<Nutssh>
Yes, but its stronger than that. f's type *must* be A, so we add in a second constranit A=D. Its superflouis in this example.
<pattern>
i don't understand why you stress the word "must"
<pattern>
i understand it must, because that's what we've calculated
<pattern>
but why stress the fact?
<Nutssh>
Because it isn't analogious. That equality must hold.
<pattern>
i see
<pattern>
that's what i meant
<pattern>
i just didn't know the correct terminology
<Nutssh>
If it was (foo (2*f)) and (2*f):B and foo:A->X then the constraint A=B would have to be added in.
<Nutssh>
Anyways, why don't you restate all of the types and constraints then try to solve them?
<pattern>
let rec foo f x = f ( foo f ) x
<pattern>
foo: A -> B -> C
<pattern>
f: D
<pattern>
foo: E
<pattern>
x: G
<pattern>
(foo f): H
<Nutssh>
*hmms* Anyone else here who remembers type systems to explain why ''let id x = x;; let foo x = id (id x);;'' isn't ill-typed like I'd expect?
<pattern>
E=D->H
<pattern>
D=H->G->I
<pattern>
A=D
<pattern>
B=G
<pattern>
C=I
<pattern>
foo: A->X
<pattern>
X=B->C
<pattern>
H=X
<Nutssh>
and D=A.
<pattern>
A=D is there
giedi has joined #ocaml
<Nutssh>
Looks good, except we'll ignore the 'foo: A-> B -> C' line.
<Nutssh>
Solve the equations and get?
<pattern>
foo: ( X -> G -> I ) -> G -> I
<Nutssh>
You forgot to simplify out X=B->C
<pattern>
ah
<pattern>
yeah, i did forget that
<pattern>
foo: ( X -> X ) -> G -> I
<pattern>
and actually foo: ( X -> X ) -> X
<Nutssh>
There's an algorithm for doing it. Simplify out each rule with a global substitution. When no rulels are left, you are done. This is important to make sure you've done every constraint.
<pattern>
i see
<Nutssh>
(By global substitution, substitute into both all of the expression types, and all the yet-to-be-applied substitution rules)
<pattern>
what's the difference between an expressiontype and a substitution rule?
<pattern>
f: D = expression type?
<Nutssh>
Yeah.
<pattern>
A=D = substitution rule?
<Nutssh>
Yeah.
<pattern>
ok
<Nutssh>
They're type equations, but we're treating them essentially as substition rules.
<pattern>
so does foo:( X -> X ) -> X look right?
<pattern>
no, that can't be right
<Nutssh>
No. You've not done the X= type equation.
<Nutssh>
You're taking a shortcut.
<pattern>
i guess i'm confused
<pattern>
maybe i should go through the substitutions step by step with you?
<pattern>
who's ever guess that twelve little tokens can be so complex?
<Nutssh>
If you'd done it mechanically you'd have noticed another flaw in it.. E=A->X
<pattern>
so what's wrong with E=A->X ?
<Nutssh>
You didn't have it in.
<pattern>
oh
<pattern>
i didn't do it mechanically, that is true
<Nutssh>
Yes. Now substitute for H=(B->C) and B=G and C=I and what do you get?
<Nutssh>
(Gotta parenthesise correctly. What I did I missed a pair of parenthesis, but you should look over it, *study* what happens.
<pattern>
((G->I)->G->I)->G->I
<Nutssh>
And what is the ocaml type?
<pattern>
foo:((G->I)->G->I)->G->I
<pattern>
foo(('a->'b)->'a->'b)->'a->'b
<Nutssh>
Look familiar?
<Nutssh>
:)
<pattern>
yes
<pattern>
now what the hell does it do?
<pattern>
i know the type now, and i know i'm going to have to practice this a bizillion times before i can do this naturally
<pattern>
but i still don't understand the funnction
<pattern>
how can it call recurse on itself without a way to terminate, even if it is partially applied?
<Nutssh>
From the type, it looks like unSOMETHING (I forget what the something is) It isn't recursing on itself.
<pattern>
well, it's a fixed point function
<pattern>
"foo" is actually "FIX" in the original
<pattern>
"The purpose of the FIX function is to compute the fixed points of other functions. (Meaning: x is a fixed point of the function f if f(x) = x.)"
<pattern>
but that clears up nothing for me
<pattern>
i still don't understand how it works
<Nutssh>
Its another way to represent recursion.. Roughly, f until it no longer changes. Its a trick for analyzing programs in type theory.
<pattern>
but how does it not recurse?
<pattern>
oh, it's partially applied
<pattern>
so it doesn't get called
<pattern>
or it gets called but only applied partially so doesn't recurse
<pattern>
i think i almost got it
<Nutssh>
:)
<pattern>
so f is called with this partially applied function "( foo f )" (or "( FIX f )") and x
<pattern>
so what's f supposed to do with this partially applied function?
<Nutssh>
Yes, giving it the option to either 'recurse again', by having f invoke its first argument, or not.
<pattern>
i see
<pattern>
very strange
<pattern>
things are so much simpler in c
<pattern>
you just pass a function pointer and do with it what you will
<Nutssh>
fact fixFact (i,accum) = if i==0 then accum else fixFact (i-1,accum*i)
<Nutssh>
fix fact 10
<Nutssh>
It shows that recursion isn't necessary as an explicit language feature.
<pattern>
that just looks like a normal recursive function to me
ott has joined #ocaml
<pattern>
oh, wait
<pattern>
i missed the "fix"
<Nutssh>
let rec fix f x = f ( fix f ) x;;
<Nutssh>
let fact fixFact (i,accum) = if i==0 then accum else fixFact (i-1,accum*i);;
<Nutssh>
fix fact (6,1);;
<pattern>
but fixFact only has one argument, and that's a tuple
<pattern>
how can fixFact be passed a partially evaluated function instead of the tuple?
<Nutssh>
Run the code. Note that fact is not recursive.
<Nutssh>
Its just an idiom that avoids explicit recursion. Generally, you use 'let rec' instead, but fixpoints have their uses for theoretical analysis, because they're simpler.
<Nutssh>
To show you how relevant it is, I didn't recognize it as fix until you said it was. :)
<pattern>
well, in this tutorial they use it for an example of delayed evaluation, in an attempt to make ml lazy
<pattern>
i don't fully understand it (as you may have gathered :), but it's from "Programming in Standard ML '97: A Tutorial Introduction" by Stephen Gilmore, p48+
<Nutssh>
I'd suggest learning typing before stuff this obscure. :)
<pattern>
yeah, i definitely need to practice my type inference
<Nutssh>
Want something else to try to typecheck? Try 'let rec f = f f'
<pattern>
hmmm
<pattern>
how can that work? "let rec f" has no arguments
<Nutssh>
Doh, yeah, Was thinking of the untyped lambda.
<pattern>
you were just trying to mess with my mind!
<pattern>
;)
<Nutssh>
Want something else to try to typecheck? Try 'let rec f x = f f'
<pattern>
ok
<pattern>
f: ( A -> B ) -> B
<Nutssh>
What are the types and the equations?
<pattern>
let rec f x = f f
<pattern>
f: A -> B
<pattern>
f=C
<pattern>
C=A -> B
<pattern>
f: ( A -> B ) -> B
<Nutssh>
You forgot the equation for recursion.
<Nutssh>
(f f): E
<pattern>
oh yeah
<pattern>
why e and not D?
<pattern>
or C?
<pattern>
i mean D
<pattern>
:)
<Nutssh>
Doesn't matter.
<pattern>
ok
<pattern>
just thought there might be another letter i was missing :)
<Nutssh>
:)
<pattern>
izz hurting my brain
<Nutssh>
Save it for another day. :)
<pattern>
ok
<pattern>
thank you very very much, nutssh
<Nutssh>
Welcome.
<pattern>
you've been very patient
<pattern>
and i've learned a lot about types (hope i can remember it all)
<Nutssh>
Sure.
<Nutssh>
Spread the knowledge. :)
<pattern>
i try, at my very low level
<Nutssh>
:) Learn. Its nice to use a language where you don't have to declare types.
<pattern>
amen
<pattern>
but you still have to understand them
<pattern>
at times
<Nutssh>
Yes. Knowing types does come in handy. :)
<pattern>
how long did it take you to learn them well?
<Nutssh>
I saw it in class and again to this level of detail in an automated theorem proving course.
<pattern>
cool
<pattern>
so at least a couple of semesters?
<Nutssh>
Well, this isn't too bad, a couple of classes. You know how it works now, just gotta be more computerlike and mechanical. Like me with my substitutions. (And you *should* scroll back and read that carefully)
<pattern>
:(((((
<pattern>
i will
<pattern>
thank again for your help
<pattern>
i'm going to head off to sleep now
<Nutssh>
Sure. You're doing good.
<Nutssh>
Night.
<pattern>
:)
<pattern>
night
_JusSx_ has joined #ocaml
Nutssh has quit ["Client exiting"]
cjohnson has joined #ocaml
gim has quit [orwell.freenode.net irc.freenode.net]
_JusSx_ has quit [Read error: 104 (Connection reset by peer)]
gim has joined #ocaml
cjohnson has quit ["Drawn beyond the lines of reason"]
noss has joined #ocaml
_JusSx_ has joined #ocaml
_JusSx_ has quit [Remote closed the connection]
lam has quit ["Lost terminal"]
Etaoin has joined #ocaml
lam has joined #ocaml
drWorm_ has joined #ocaml
<drWorm_>
if i have an .ml file with a bunch of functions and stuff, and want to sort of load it into the ocaml toplevel (as if i had pasted it in), is that possible? "open Filename" gives no error, but when i try to use any of the functions it gives me "Reference to undefined global `Filename'".
<gl>
type #use foo.ml
lam has quit ["Lost terminal"]
<drWorm_>
ah, thanks
<drWorm_>
hm, no luck, syntax error
<drWorm_>
ah, works with quotation mark
<drWorm_>
marks*
<karryall>
alternatively, you could use emacs
<drWorm_>
i use emacs too, but i haven't taught myself to integrate it with ocaml yet, except for C-c C-c to compile :)
<karryall>
hey drWorm_, you're from Norway ?
<drWorm_>
yeah, you?
<karryall>
from France, but I have some family in Norway
<drWorm_>
ok :) very strong ocaml community in france :>
noss has quit ["hej då"]
lam has joined #ocaml
lam has quit ["Lost terminal"]
<drWorm_>
sometimes the caml emacs mode starts indenting all wrong and i have to restart emacs to fix it, strange
<mellum>
drWorm: In that case, try M-x all-hail-emacs
<drWorm_>
[No match] :)
<mellum>
Hm, you got a weird version then :)
<drWorm_>
21.3.1
<drWorm_>
but i know it was there before :)
jesse_ has joined #ocaml
lam has joined #ocaml
mimosa has joined #ocaml
noss has joined #ocaml
ita has joined #ocaml
<ita>
hi all
<ita>
is it possible to print in colors in the console ? Printf.printf "\033[1;33m hello \033[0m\n"; won't work
stef has joined #ocaml
<karryall>
that should be "\027" I think
<karryall>
yes, that's \027 (decimal)
<ita>
karryall: great, thanks !
tomasso has joined #ocaml
gim has quit [orwell.freenode.net irc.freenode.net]
gim has joined #ocaml
drWorm_ has quit ["Leaving"]
gim has quit [orwell.freenode.net irc.freenode.net]
gim has joined #ocaml
gim has quit [orwell.freenode.net irc.freenode.net]
gim has joined #ocaml
Vincenz has joined #ocaml
cjohnson has joined #ocaml
_JusSx_ has joined #ocaml
<mellum>
Is it possible to write a function that behaves like printf, but only prints when some global flag is true?
<liralen>
yes.
<mellum>
How?
<liralen>
you'd use a reference for the 'global flag', Printf.printf, and a test.
<mellum>
That part is clear. But how to handle the unknown number of arguments?
<karryall>
let foo fmt = if !global_flag then Printf.printf fmt else ignore
<mellum>
karryall: Thanks, that might work
<noss>
can you use intel SSE on bigarray things?
<karryall>
mellum: hum, no it doesn't sorry
<mellum>
karryall: Hm, seems to print nothing?
<karryall>
well that depends of global_flag :)
<mellum>
karryall: ah, works now
<mellum>
E
<mellum>
ops
<mellum>
Except that it does work with only 1 argument...
<karryall>
yes
<mellum>
Dammit, isn't this possible without a preprocessor?
<karryall>
you could output to /dev/null :)
<karryall>
ah I found the solution
<karryall>
I hope you have 3.07
<jesse_>
have the function take no arguments, return printf if the global condition is met, and something capable of eating all of the arguments if not
<karryall>
let foo fmt = Printf.kprintf (fun s -> if !global_flag then print_string s) fmt
<mellum>
Add a ;"" and it works :)
<mellum>
I have 3.06... I wonder why it works without on 3.07
<karryall>
because the type of kprintf is different
<karryall>
in 3.06 the first argument (the continuation) has type strig -> strig
<karryall>
in 3.07 it's string -> 'a
<mellum>
Hm, unfortunately I get a warning for every invocation then...
<mellum>
I probably ought to bug the administrators to upgrade :)
<karryall>
yes because it returns the string value
<karryall>
let foo fmt = Printf.kprintf (fun s -> if !global_flag then s else "") fmt
<karryall>
and use it like this print_string (foo ...)
<mellum>
Hm, not as nice... I could just ignore the warnings :)
<liralen>
Or you could upgrade to 3.07, I suppose.
<karryall>
3.07+2 even
<mellum>
Well, I'm not root, so that'd require lots of work
<liralen>
you can install a local copy, but OK.
<mellum>
It's somewhat scary when the presence of dedicated staff means things go slower than when you had to do it all yourself
<liralen>
presumably the benefits come to reliability.
mattam_ has joined #ocaml
palomer has joined #ocaml
* palomer
is part of mothers for type classes in ocaml
<palomer>
any plans for ocaml to implement type classes?