tobiasBora has quit [Quit: Konversation terminated!]
t4nk946 has quit [Ping timeout: 246 seconds]
_twx_ has quit [Remote host closed the connection]
_twx_ has joined #ocaml
JokerDoom has joined #ocaml
shinnya has joined #ocaml
__JokerDoom has quit [Ping timeout: 272 seconds]
Algebr has joined #ocaml
<Algebr>
say you have foo, which has signature int -> bool -> string. and you call foo true 123, here the order is not matching up to the signature, but is that okay? (I think I'm seeing functions where the order doesn't match up to the signature, but the functions still executes correctly)
<Drup>
It's not ok, no
<Drup>
but you have the right to do that if the function has labels
<Drup>
foo : ~bla:int -> ~blo:bool -> string
<Drup>
you can call foo ~bla:1 ~blo:"" or foo ~blo:"" ~bla:1
<Drup>
It's used quite heavily in Core
<Algebr>
Drup: regarding the "its not ok", you mean its poor style but the code will still execute?
<Drup>
no, I mean it will not typecheck
<Drup>
if there is no labels, you can't reorder the arguments, it will not work
<Algebr>
StringMap.iter's type signature doesn't match up to the last line
<Drup>
actually, it does
<Algebr>
what
<Drup>
Are you sure you are not using the standard library and looking at Core's library ?
<Drup>
iter for the stdlib is : (key -> 'a -> unit) -> 'a t -> unit
<Drup>
which is consistent with what you wrote
<Algebr>
StringMap.iter;;
<Algebr>
- : 'a StringMap.t -> f:(key:string -> data:'a -> unit) -> unit = <fun>
<Algebr>
How is that lining up with the code?
<Drup>
that's Core's StringMap.iter
<Algebr>
but that doesn't match up with the last line of the link I posted
<Drup>
no, probably because you are not using Core in this piece of code
<dmbaturin>
Drup: Remember my yesterday brainfuck compiler questions? I've got it to work. http://bpaste.net/show/wivfBj6n7LK5bBJ0mSs0/ Would be grateful if you or anyone else checked the style and stuff.
<Drup>
Compiling to C ? hmm.
<dmbaturin>
Well, that's the easiest thing to do.
<Drup>
oh no, an interpreter is easier
<dmbaturin>
If I want an interpeter, what is the best way to represent a tape? Using a list?
<Drup>
a zipper
<Drup>
'a list * 'a * 'a list
<Drup>
(or just a vector + the position)
<Drup>
(if you want it stateful)
<dmbaturin>
I'm not sure I understand what 'a means, even though I've seen it in type error messages.
<Drup>
It's a type variable
<Drup>
type 'a tape = 'a list * 'a * 'a list is "a tape containing things of type 'a"
<dmbaturin>
So it's just a type placeholder?
<Drup>
yes
<Drup>
dmbaturin: which languages are you familiar with ?
<dmbaturin>
Drup: C, python, perl, ada, java, common lisp (in order of familiarity).
<Drup>
hum, I think there is polymorphism in Ada
penglingbo has joined #ocaml
<dmbaturin>
Yep, there is.
<Drup>
so you should be in known territory
q66 has quit [Quit: Leaving]
<Drup>
(but I can't see how you express that in Ada by looking at the documentation =_=)
ygrek has joined #ocaml
<Drup>
Ada's syntax is not elegant.
<dmbaturin>
Drup: In generics it's "type something is private", you substitute it for actual type when instantiating the package.
<Drup>
huum, why not
<dmbaturin>
I need to read about type definitions in ocaml and try that. Haven't tried it.
pjdelport has quit [Quit: Connection closed for inactivity]
<Drup>
otherwise, about your code
<Drup>
translate can be defined "List.map translate_char"
<Drup>
read_source can be defined in a more efficient (and shorter way) using "in_channel_length" and Buffer.add_channel
englishm has joined #ocaml
<Drup>
I would have inlined update_nesting_level in check_nesting_level, but it's a matter of taste
<dmbaturin>
Drup: True, initially I wanted to put both translation and bracket checking in one translate function, but couldn't come up with a (non-imperative) solution for it.
<Drup>
"let f c = match c with ..." can be shortened in "let f = function ..."
<dmbaturin>
Need to read about the Buffer.
<dmbaturin>
Oh, yeah, about the "function". Is "let f x = match x with ..." and "let f x = function |" exactly the same thing?
<Drup>
yes
<Drup>
(one is sugar for the other, actually)
<dmbaturin>
Good to know there's no subtle difference between the two. :)
<Drup>
you could rewrite the line 59 with buffer too
NoNNaN has quit [Ping timeout: 264 seconds]
<Drup>
otherwise ... happy segfaults if you go over 9999 memory adress :D
<dmbaturin>
Wait, so there's no bounds checking?
<Drup>
in ocaml ? sure
<Drup>
in C .... :]
<dmbaturin>
Ah, you mean in generated code. It's up to the user if their BF program segfaults. :)
<Drup>
not if it's only because the compiler is bad :D
<dmbaturin>
The original one used a fixed-size array for tape as well AFAIR. I'm too lazy to make it really correct.
<dmbaturin>
Maybe will add bounds checking if I have nothing to do.
<dmbaturin>
Since there is no way to recover from it, telling the user that the program was about to segfault is not _much_ better than segfaulting. :)
<dmbaturin>
Apart from doing realloc() of course.
araujo has joined #ocaml
NoNNaN has joined #ocaml
troutwine_away is now known as troutwine
englishm1 has joined #ocaml
NoNNaN has quit [Ping timeout: 264 seconds]
mort___ has left #ocaml [#ocaml]
philtor has joined #ocaml
tidren has quit [Remote host closed the connection]
tidren has joined #ocaml
tidren has quit [Read error: Connection reset by peer]
tidren has joined #ocaml
englishm1 has quit [Ping timeout: 240 seconds]
englishm has quit [Ping timeout: 264 seconds]
drbrule has joined #ocaml
tidren has quit [Remote host closed the connection]
<drbrule>
Hello. If someone would be so kind as to give me a bit of guidance, I would be most obliged.
philtor has quit [Ping timeout: 245 seconds]
<drbrule>
I'm trying to use StringMap.fold_left to invert the values on a list (so from key value -> value key). However, I'm having trouble learning the correct syntax
omqal has quit [Quit: omqal]
<drbrule>
I'm presently using the following, which is wrong: StringMap.fold_left (fun key value -> (value, key)
englishm has joined #ocaml
englishm_ has joined #ocaml
<Drup>
StringMap.fold_left is not the right way to do that
englishm1 has joined #ocaml
<drbrule>
Oh? Can I do it with StringMap.fold_right?
<Drup>
you want to transform a list [ ("bla", 1) ; ("blo", 2) ] into [ (1 , "bla") ; (2, "blo") ], right ?
<drbrule>
Yes, but I need to utilize StringMap.fold as part of the exercise.
<Drup>
Ah.
<Drup>
It's so backward I don't even how you are supposed to do it
<drbrule>
It didn't seem appropriate to me either, but I guess that's the point to make me learn how to do it right.
<Drup>
There are no other directives ?
<drbrule>
... "hen use StringMap.fold to convert this to a list of (count, word) tuples"
englishm has quit [Ping timeout: 260 seconds]
<Drup>
So you actually know how to do the rest and you just want to know how to extract a list ?
<drbrule>
So far I've built a histogram/word counter
<drbrule>
The result is in a StringMap, with ( key value)
<drbrule>
I need to switch those in the StringMap, but I must use fold
<Drup>
right, so you don't want to "invert the values on a list", you just want the list of bindings in a map :)
<drbrule>
yes, sorry, my phrasing was wrong.
<Drup>
so
<Drup>
give me the type of StringMap.fold please
<drbrule>
I just tried with StringMap.fold_left
<drbrule>
but I believe my syntax is all wrong.
<Drup>
what did you tried ?
<Drup>
(your previous code sample was incomplete)
<drbrule>
StringMap.fold_left (fun key value -> (value, key))
<drbrule>
that's the whole line
<Drup>
that's wrong for several reasons
<Drup>
as I said before, what is the type of fold_left ?
<drbrule>
I'm not sure how fold_left can have a type?
<Drup>
well, it's a function, it has a type.
<drbrule>
Not sure how to look that up...
<Drup>
you don't know where to look for the documentation ? How do you expect to use a function if you have no idea what the function takes as argument ? :p
<drbrule>
I promise I've tried searching many times for fold documentation
<Drup>
well, from this page, val fold : (Map.S.key -> 'a -> 'b -> 'b) -> 'a Map.S.t -> 'b -> 'b
<drbrule>
not sure what a val is.
<Drup>
a value
<drbrule>
sure, but that can't be the type right?
<Drup>
why not ?
<drbrule>
it seems quite abstract.
<drbrule>
value doesn't describe much
<Drup>
fold is an abstract operation :)
<drbrule>
well, it's the first time I've seen val be a type then.
<Drup>
val doesn't matter, it's just a keyword
<Drup>
"(Map.S.key -> 'a -> 'b -> 'b) -> 'a Map.S.t -> 'b -> 'b" <- this is the type.
<drbrule>
yeah, I'm not totally clear. those are function mappings obviously.
<drbrule>
what do the ' mean?
<Drup>
which we could reformulate, since we are talking about a StringMap, into : "(string-> 'a -> 'b -> 'b) -> 'a StringMap.t -> 'b -> 'b
<Drup>
it's a type variable
<Drup>
'a is "a something" (and all 'a are the same something)
<drbrule>
oh right ok
<Drup>
so, what are the elements inside your map ?
<drbrule>
string and integer
<Drup>
So what should be 'a for you ?
<drbrule>
string
<drbrule>
which maps to an int, which then maps to the previously mentioned string?
<Drup>
failed, 1/2 chances :D
<Drup>
'a is the type of the *values*, string are the keys
<Drup>
(at least here)
<drbrule>
ok, so its: string -> "stringthing"
<Drup>
hum ?
<drbrule>
so a' = string and b' = "actualstring"
<Drup>
No.
<Drup>
in your map, the values are integer, right ?
<drbrule>
when I print it out as value, key I get "String" : count
<Drup>
I doubt so, It's a StringMap, your keys are strings.
<Drup>
so it's printed as (key, value) if you get "String" : count
<drbrule>
sorry sorry,
<Drup>
So, since you have integer values
<drbrule>
I just realized I reversed it because I wanted the print statement to work when I figured out how to reverse it
<Drup>
you have an int StringMap.t
<Drup>
so we want 'a = int
tidren has joined #ocaml
<Drup>
We want to figure out which functions to give to fold
<drbrule>
ok
<Drup>
for now, we know this function should be of type "string -> int -> 'b -> 'b"
<drbrule>
ok
<Drup>
we want to return a list of (key, value)
<Drup>
what is the type of that ?
<drbrule>
int -> string -> 'a -> 'a ?
<Drup>
no, that's not the type of a list
<drbrule>
sorry, I'm slow...
<Drup>
take your time, you need to figure that out by yourself. Help yourself with type ocaml toplevel
<Drup>
if you type something, the toplevel will give you the type
<Drup>
with the*
<drbrule>
hmm
<drbrule>
I understand that lists in ocaml are singly linked lists, is that what I was looking for?
<Drup>
yes
<drbrule>
ok, so in this case the string (a') is associated with a pointer that goes to the count (b'), which then is associated with a pointer that goes back to the same string?
<Drup>
oh, you are a C programmer, explain why you are so confused :O
<Drup>
so, forget everything about pointers.
<drbrule>
yes, c background.
<drbrule>
ok
<drbrule>
also, stringmap isn't in the ocaml ref?
<drbrule>
Where is it? Core?
<Drup>
hum, you were looking at batteries' documentation, so I assumed you were using batteries knowingly
<drbrule>
nope, googled it is all
<drbrule>
Hmm... I see batteries is it's own library.
<Drup>
yep
<drbrule>
Does it come with ocaml or something? how am I using Stringmap?
<drbrule>
I'll check the real world ocaml install guide
<drbrule>
I might have installed it with opam early on without realizing it
<drbrule>
Can I look up on toplevel where a function originates?
derek_c has quit [Ping timeout: 250 seconds]
fold has quit [Ping timeout: 250 seconds]
<Drup>
not really, except by the name
<drbrule>
I don't have a lot to go off with
<drbrule>
I dropped the _left
<drbrule>
now when I run StringMap.fold (fun key value -> (value, key)), I get This expression has type 'a * 'b but an expression was expected of type ('c -> 'd) -> 'c -> 'd
<drbrule>
I can't see how it has type 'a * 'b, there's no operator there.
<Drup>
hum, Have you tried to read up some tutorials before picking up this assignment ?
<drbrule>
a few, but I haven't finished Real World Ocaml
<drbrule>
I'm mid way through ch 1
<Drup>
I would advise to keep reading
jpdeplaix has quit [Ping timeout: 272 seconds]
<Drup>
because you are clearly missing a good amount of basic notions
<drbrule>
specifically on types?
<Drup>
among other, yes
jpdeplaix has joined #ocaml
<drbrule>
ok, will do... thanks for guidance. I really appreciate you taking the time.
<Drup>
no problem
<drbrule>
I guess I'm just more used to being able to look up documentation of functions a bit easier.
<Drup>
Correction : you don't know how to read Ocaml's documentation yet.
<drbrule>
Is there a guide to the documentation? I've got the reference manual PDF but nothing on StringMap
<drbrule>
I think I might almost get it: fold f m a computes (f kN dN ... (f k1 d1 a)...), where k1 ... kN are the keys of all bindings in m (in increasing order), and d1 ... dN are the associated data.
<drbrule>
I just am not clear what a is
demonimin has joined #ocaml
<drbrule>
it's a function that takes three inputs?
racycle has joined #ocaml
<Drup>
no, "a" is the "start" of the fold
<drbrule>
not sure what you mean start of the fold, you mean the value that the key must equal before the function is triggerred?
<Drup>
no
<Drup>
look closer at the first application of f in the text you coppied
<Drup>
"f k1 d1 a"
<xenocons>
sounds rude
<drbrule>
so f is applied to each set but only if a is met?
<Drup>
Nope
<Drup>
if we unfold a bit, we can write it : let a1 = f k1 d1 a in let a2 = f k2 d2 a1 in ...."
<drbrule>
yeah, I see that
<drbrule>
every set is "dealt with"
<drbrule>
is a an accumulator of some kind?
<Drup>
exactly.
<drbrule>
ah
<drbrule>
makes sense now
<Drup>
more precisely, a is the initial value of the accumulator,
<drbrule>
I can't understand how StringMap.fold would possibly be a good candidate for converting a stringMap of string, counts to a list of (count, word) tuples
<Drup>
well, a list is a very good accumulator.
troutwine is now known as troutwine_away
fold has joined #ocaml
derek_c has joined #ocaml
ggole has joined #ocaml
ygrek has quit [Ping timeout: 250 seconds]
racycle has quit [Quit: ZZZzzz…]
WraithM has joined #ocaml
badon has quit [Ping timeout: 245 seconds]
badon_ has joined #ocaml
badon_ is now known as badon
Denommus has left #ocaml ["ERC Version 5.3 (IRC client for Emacs)"]
siddharthv_away is now known as siddharthv
ygrek has joined #ocaml
araujo has quit [Quit: Leaving]
Antoine59 has quit [Ping timeout: 264 seconds]
axiles has joined #ocaml
WraithM has quit [Ping timeout: 250 seconds]
gal_bolle has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
_0xAX has joined #ocaml
hhugo has joined #ocaml
Simn has joined #ocaml
dsheets has quit [Ping timeout: 240 seconds]
mort___ has joined #ocaml
baz_ has quit [Quit: Lost terminal]
yacks has quit [Read error: Connection reset by peer]
yacks has joined #ocaml
parcs has quit [Read error: Connection reset by peer]
parcs has joined #ocaml
mort___ has quit [Remote host closed the connection]
hhugo has quit [Quit: Leaving.]
cago has joined #ocaml
hhugo has joined #ocaml
zpe has joined #ocaml
dsheets has joined #ocaml
hhugo has quit [Quit: Leaving.]
sagotch has joined #ocaml
drbrule has quit [Ping timeout: 264 seconds]
q[mrw] has joined #ocaml
ygrek has joined #ocaml
lostman has joined #ocaml
Eyyub has quit [Ping timeout: 250 seconds]
wwilly has joined #ocaml
ddosia has quit [Quit: Leaving.]
zpe has quit [Remote host closed the connection]
Eyyub has joined #ocaml
hhugo has joined #ocaml
tane has joined #ocaml
q[mrw] has left #ocaml [#ocaml]
testcocoon has quit [Quit: Coyote finally caught me]
derek_c has quit [Quit: Leaving]
testcocoon has joined #ocaml
hhugo has quit [Quit: Leaving.]
<Unhammer>
http://sprunge.us/SZgj heh, batteries has hardcoded the path to toplevel.help?
alpounet has joined #ocaml
sagotch has quit [Ping timeout: 240 seconds]
tidren has quit [Remote host closed the connection]
sagotch has joined #ocaml
Gonzih has joined #ocaml
zpe has joined #ocaml
gal_bolle has quit [Read error: Connection reset by peer]
gal_bolle has joined #ocaml
<ygrek>
symlink
Submarine has joined #ocaml
Kakadu has joined #ocaml
gal_bolle has quit [Quit: Konversation terminated!]
jnaimard has joined #ocaml
jnaimard is now known as gal_bolle
shinnya has quit [Ping timeout: 240 seconds]
<Unhammer>
argh why is [1,2] not a syntax error
<dsheets>
Unhammer, because it's a beautiful tuple in a list
<Unhammer>
:(
<dsheets>
makes [ a,b,c;\n d,e,f;\n g,hi;\n] beautiful
<dsheets>
s/hi/h,i/
<dsheets>
let a,b = some_tuple_maker () also works
<dsheets>
or let f x = x,x*2
tidren has joined #ocaml
arj has joined #ocaml
<gal_bolle>
ocaml is a bit baroque with its taste for trompe-l'œil aesthetics
<dsheets>
Unhammer, also, the type-checker will almost certainly catch the error
<Kakadu>
oh. What language it is , gal_bolle ? AFAIK french doesn't have æ letter...
<Kakadu>
œ neither
<gal_bolle>
it's english with a french loanword
BitPuffin has joined #ocaml
<gal_bolle>
œ is french indeed (and afaik, unique to it)
<Kakadu>
Is it a French letter or an agreement to write o and e together?
<arj>
it actually is a letter on its own
<Unhammer>
dsheets, it did, I just didn't understand where the problem was coming from since it showed up far from where I had defined the error
<Kakadu>
I checked French alphabet but there is no œ there ... does Wikipedia suck?
<arj>
Kakadu: ehm sorry, not a letter in that way. Letter in the sense of ligature.
<dsheets>
Unhammer, ah, i can see how that may be confusing
<dsheets>
Unhammer, i think of ; as a sequencing operator and [||] and [] define sequences that aren't (necessarily) unit-valued side effects. That records use ;, too, seems like a quirk but understandable as tuples own ,
<Unhammer>
hmm; makes sense
FreeArtMan has joined #ocaml
rand000 has joined #ocaml
BitPuffin has quit [Ping timeout: 240 seconds]
BitPuffin has joined #ocaml
Algebr has quit [Remote host closed the connection]
<def`>
(and æ can be found insome latin word which are part of french)
tidren has quit [Remote host closed the connection]
pjdelport has joined #ocaml
<Reventlov>
def`: any example ?
testcocoon has quit [Quit: Coyote finally caught me]
<tobiasBora>
* I used in fact the function FileUtil.(rm ~recurse:true [".tmp"]);
<whitequark>
dsheets: I don't think ; provides ordering guarantees in []/[||]
<whitequark>
in fact, I'm pretty sure it does not
<dsheets>
whitequark, sequencing not side effects
<whitequark>
I mean, I think it might be confusing to treat bare ; and ; in [] as the same/similar thing.
<whitequark>
I just think of it as a separator.
<dsheets>
i see what you mean. I think they are similar in terms of IO monad vs list mon[a|oi]d
<dsheets>
it's fairly common to see a list literal opened and then have a sequence of expressions with each line ending in ";"
<ggole>
Evaluation of parts is undefined for pretty much everything afaik
<ggole>
Er, order of evaluation.
<Unhammer>
M-x highlight-regexp RET ~pat: RET hi-red-b RET
Eyyub has quit [Ping timeout: 240 seconds]
siddharthv is now known as siddharthv_away
arj1 has joined #ocaml
arj has quit [Read error: Connection reset by peer]
englishm_ has joined #ocaml
Gonzih has quit [Ping timeout: 245 seconds]
englishm1 has joined #ocaml
NoNNaN has joined #ocaml
englishm has joined #ocaml
english__ has joined #ocaml
englishm has quit [Client Quit]
englishm_ has quit [Ping timeout: 240 seconds]
englishm1 has quit [Ping timeout: 245 seconds]
darkf has quit [Quit: Leaving]
thomasga has quit [Quit: Leaving.]
thomasga has joined #ocaml
penglingbo has quit [Ping timeout: 264 seconds]
ddosia has joined #ocaml
johnnydiabetic has joined #ocaml
shinnya has quit [Ping timeout: 245 seconds]
BitPuffin has quit [Quit: See you on the dark side of the moon!]
shinnya has joined #ocaml
BitPuffin has joined #ocaml
AltGr has joined #ocaml
tobiasBora has quit [Ping timeout: 250 seconds]
penglingbo has joined #ocaml
maattdd has joined #ocaml
typedlambda has quit [Ping timeout: 250 seconds]
avsm has joined #ocaml
typedlambda has joined #ocaml
ygrek has quit [Ping timeout: 250 seconds]
johnnydiabetic has quit [Quit: Goodbye]
Gonzih has joined #ocaml
johnnydiabetic has joined #ocaml
drbrule has joined #ocaml
Antoine59 has joined #ocaml
jprakash has joined #ocaml
Algebr has joined #ocaml
<Algebr>
Wondering why I can't do for Foo of string option, Foo @@ Some "thing"
elfring has joined #ocaml
<ggole>
Constructors aren't functions
<Algebr>
I thought they acted like functions
<ggole>
You could do (fun x -> Foo x) @@ Some "thing", but that would be pretty ridiculous
<Algebr>
yes, that's silly.
jsvgoncalves has joined #ocaml
<ggole>
In SML, and Haskell, but not OCaml. Sorry.
<ggole>
Foo (Some "thing") it is.
FreeArtMon has joined #ocaml
<Algebr>
Is F# like a CLR version of ocaml?
avsm has quit [Quit: Leaving.]
<ggole>
Similar.
<ggole>
It has some things ocaml doesn't have, lacks some things ocaml does.
FreeArtMan has quit [Ping timeout: 250 seconds]
FreeArtMon has quit [Remote host closed the connection]
<Algebr>
I wonder why merlin doesn't play nice with .mlls?
ygrek has joined #ocaml
<def`>
Algebr: no parser for mll
<def`>
Algebr: contributions welcome =]
avsm has joined #ocaml
<Algebr>
ha, maybe when I'm better.
<def`>
Algebr: just open an issue on github.com/the-lambda-church/merlin so that we don't forget
<Algebr>
def`: I played with apple's swift and its outright copying how much was taken from ocaml/haskell, which is suppose is a good thing in some sense.
<ggole>
That's OK, OCaml stole plenty of its own (from SML, mostly)
FreeArtMan has joined #ocaml
<def`>
Yep, that's a good thing, much better than seeing languages like Go and Dart being depicted as 'modern'
<def`>
(Though they could have made this a bit more public, rather than bullshitting supposed relationships with other mainstream langages probably to get some traction from Joe)
araujo has joined #ocaml
<Algebr>
doing let () is in effect the same as let _, right?
<def`>
let () is a bit more strict
<def`>
as let _ will let any type passes while let () require a unit
<def`>
this might be useful to catch partial applications for instance
<Algebr>
ah, so () is a special case for _
<def`>
let _ = prerr_endline;; (* oops forgot argument *)
<def`>
let () = prerr_endline;; (* type error *)
<ggole>
() is just a constructor
<def`>
Not really, it's just that the syntax is let <pattern> = <expression
<def`>
_ is a pattern as () is :)
<ggole>
So... yeah
olauzon has joined #ocaml
Antoine59 is now known as Youri
<ggole>
Does Haskell have irrefutable matches?
<def`>
yes, there is this notion in haskell too
<ggole>
Mmm.
<def`>
though it has a slightly different meaning in haskell
drbrule has quit [Remote host closed the connection]
drbrule has joined #ocaml
mort___ has joined #ocaml
<ggole>
Similar indeed - in fact I'm not sure what the difference is
<def`>
well, because of lazy semantics, irrefutable pattern will succeed without the value being forced
<def`>
but if bound identifiers are forced when pattern doesn't match, it fails
<ggole>
Ah, I see
drbrule_ has joined #ocaml
drbrule has quit [Ping timeout: 256 seconds]
drbrule_ has quit [Ping timeout: 240 seconds]
_0xAX has quit [Remote host closed the connection]
mort___ has quit [Quit: Leaving.]
mort___ has joined #ocaml
avsm has quit [Quit: Leaving.]
morphles has joined #ocaml
jsvgoncalves has quit [Remote host closed the connection]
<Algebr>
when defining a variant, the following is the same? Foo of int and Foo int
<def`>
the second is incorrect
<Algebr>
ah yes, my bad entirely
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
<Algebr>
def`: I have a data structure that I want an interpreter to hold, say an array for variables. Where could I define that array? would it be in the .mly/.mll or in the eval.ml?
<Drup>
I usually do the minimum amount of things during lexing/parsing and only outputs an almost pure AST, and I transform this ast into whatever data structure I need afterward.
<Drup>
It decouples the syntax and the semantic, if you want to modify the parser, it's easier
<Algebr>
right, but for sake of argument on this one. I know its possible to put arbitrary ocaml code in the .mll within {}, but can I put an array in a .mly?
<def`>
you can put arbitrary code but it won't be exposed in the .mli
Hannibal_Smith has joined #ocaml
<def`>
so the best is to put it in some separate file and refers to it in the mly
<Drup>
or more precisely, rules declared with %start
<def`>
Algebr: hu no, %type is only for grammar symbols
<def`>
Drup: any non-terminal is accepted
drbrule has joined #ocaml
<drbrule>
Hello. Getting an error with new_list at end: let new_list = [] in let b = StringMap.fold (fun str value accum_list -> List.append accum_list [(str, value)]) (histogram wordlist) new_list in
<drbrule>
has type (StringMap.key * int) list but an expression was expected of type string list Type StringMap.key * int is not compatible with type string
Eyyub has joined #ocaml
<drbrule>
I thought [] was mutable, so the type woudn't matter?
philtor has joined #ocaml
<Drup>
[] is not mutable
<drbrule>
oh
zpe has quit [Remote host closed the connection]
<ggole>
drbrule: StringMap.bindings might be handy
<drbrule>
ok
<ggole>
Also, your approach there has quadratic complexity: List.append is linear in the length of its first argument.
<Drup>
ggole: it's an exercise :3
<ggole>
If you were going to do it by hand, you'd probably cons an element onto the list and reverse it at the end (if you cared about ordering)
ewd has joined #ocaml
<ggole>
Drup: all the more reason to do it right
<drbrule>
Yeah, the requirement is to use StringMap.fold
<Drup>
ggole: I was answering to "use StringMap.bindings"
<ggole>
Ah, ok
<ewd>
how is the ocaml way of testing code, i.e. like quick-check in haskell?
<ggole>
There's ounit, a sort-of port of quickcheck, and good old assert.
<drbrule>
If I do: let new_list = List.empty in , I get a Unbound value error.
drbrule has quit [Remote host closed the connection]
troutwine_away is now known as troutwine
<ewd>
Thanks!
drbrule has joined #ocaml
philtor has quit [Ping timeout: 240 seconds]
<drbrule>
Sorry, my wifi connection is awful.
<Drup>
drbrule: there is no such thing as List.empty, use []
<drbrule>
I tried that, but I get this error: This expression has type (StringMap.key * int) list but an expression was expected of type string list . Type StringMap.key * int is not compatible with type string
jao has quit [Read error: Connection reset by peer]
Gonzih has quit [Ping timeout: 250 seconds]
<Drup>
show the whole code.
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
<bernardofpc>
drbrule: also, use pastebin, it's better
<Drup>
"List.iter print_endline" is then of type "string list -> unit"
<Drup>
your are giving him a (StringMap.key * int) list
<Drup>
don't use print_endline to print your list :)
<drbrule>
oh, I thought the error was the line above
<drbrule>
ok
<Drup>
hey, the typechecker gives you a precise location ;)
<Drup>
Rule of thumb : the typechecker is right, you are wrong.
<drbrule>
fair enough
cago has quit [Quit: cago]
Anarchos has joined #ocaml
troutwine is now known as troutwine_away
<whitequark>
the typechecker doesn't usually highlight the *root* of the error though
<whitequark>
and it is annoying in highly-higher-order code
yroeht has quit [Ping timeout: 272 seconds]
arj1 has quit [Quit: Leaving.]
philtor has joined #ocaml
penglingbo has quit [Ping timeout: 256 seconds]
maattdd has quit [Ping timeout: 256 seconds]
FreeArtMan has quit [Ping timeout: 264 seconds]
philtor has quit [Ping timeout: 256 seconds]
drbrule has quit [Remote host closed the connection]
jwatzman|work has joined #ocaml
badon has quit [Ping timeout: 240 seconds]
shinnya has quit [Ping timeout: 264 seconds]
pminten has joined #ocaml
pminten has quit [Client Quit]
pminten has joined #ocaml
<flux>
I've found replacing type errors with assert false to be a useful tool with type errors
<flux>
(I suppose this is for the benefit of the few new faces here)
sagotch has quit [Remote host closed the connection]
englishm has joined #ocaml
english__ has quit [Ping timeout: 240 seconds]
Kakadu has quit [Ping timeout: 246 seconds]
mort___ has quit [Quit: Leaving.]
parcs has quit [Remote host closed the connection]
badon has joined #ocaml
parcs has joined #ocaml
zpe has joined #ocaml
drbrule has joined #ocaml
FreeArtMan has joined #ocaml
AltGr has left #ocaml [#ocaml]
zpe has quit [Ping timeout: 250 seconds]
pgomes has joined #ocaml
<nickmeharry>
I thought that's what 'failwith "TODO"' was for (moving compile errors to runtime)
<drbrule>
when I run let b = StringMap.fold (fun key value alist -> List.append alist [(key, value)]) (histogram wordlist) new_list, is new_list "copied" to b when complete?
reynir is now known as reynir|AwayNick
<drbrule>
I imagine the outpit of the StringMap.fold function is the accumulator.
zpe has joined #ocaml
<nickmeharry>
Yes, the result of a fold is the accumulator after the fold is done.
<nickmeharry>
It's "accumulating" the result through the function calls.
<nickmeharry>
I'm not sure why new_list needs to be copied here, though.
<bernardofpc>
drbrule: not copied
<nickmeharry>
b would be a reference to a list that at some point is connected to new_list
<bernardofpc>
in fact, new_list is never changed]
q66 has joined #ocaml
<def`>
yep, no mutation, no copy
<bernardofpc>
the function (fold) creates new values as it folds through your StringMap
<bernardofpc>
the last one is its return value
<drbrule>
ok
<bernardofpc>
(of course, all previous values are used in building the last one,)
<bernardofpc>
one nice way to understand this is to have List.fold_left invert a list
<drbrule>
I realize I could get rid of b, but shouldn't this work?: List.iter (fun (key, value) -> Printf.printf "%s : $d\n" key value) b
Denommus has joined #ocaml
<bernardofpc>
something like let my_reverse li = List.fold_left (* fill here *) li
<bernardofpc>
drbrule: %d
<drbrule>
oops
<bernardofpc>
It should have given you a type error "function applied to too many arguments" (or something like that)
<drbrule>
jesus it works.
<drbrule>
holy hell.
<Algebr>
drbrule: of course it works.
<drbrule>
I could kiss you all right now.
<def`>
drbrule: next step is removing use of List.append :))
drbrule has quit [Read error: Connection reset by peer]
manizzle has quit [Ping timeout: 250 seconds]
drbrule has joined #ocaml
Denommus` has joined #ocaml
<Denommus`>
hi
drbrule has quit [Read error: Connection reset by peer]
<Denommus`>
which mode for Emacs should I use? tuareg?
drbrule has joined #ocaml
<Denommus>
testing
pminten has quit [Remote host closed the connection]
strmpnk has joined #ocaml
Denommus` has quit [Client Quit]
drbrule has quit [Ping timeout: 260 seconds]
Kakadu has joined #ocaml
<sorabji>
Denommus: ocaml?
<Denommus>
sorabji: there isn't an ocaml-mode in the package.el repositories. But I have installed tuareg
<sorabji>
i think tuareg is the usual mode. there's also merlin for code introspection, and utop for a nice repl experience
englishm has quit [Remote host closed the connection]
<sorabji>
gleaned from my one day of fooling with ocaml :D
<smondet>
Denommus: I think ocp-indent also some comes with some elisp that you can use to have better indenting
<Denommus>
heh, I also started yesterday
dsheets has quit [Ping timeout: 260 seconds]
englishm has joined #ocaml
<sorabji>
i'm short on ideas :(
<Denommus>
sorabji: try to implement Haskell's Functor typeclass in OCaml
tane has joined #ocaml
<sorabji>
that's quite a ways away from the things i usually build
<Algebr>
sorabji: its actually not that bad.
troutwine_away is now known as troutwine
reynir|AwayNick is now known as reynir
<Denommus>
sorabji: it's quite easy
mort___ has joined #ocaml
troutwine is now known as troutwine_away
yroeht has joined #ocaml
morphles has joined #ocaml
manizzle has joined #ocaml
drbrule has joined #ocaml
WraithM has joined #ocaml
dsheets has joined #ocaml
<sorabji>
abstract though.
<drbrule>
I'm trying to switch a list consisting of (x, y) to (y, x) where y and x are diff types: let wordcounts = StringMap.fold (fun value key alist -> List.append alist [(key, value)]) (histogram wordlist) [] in . This gives me an error of different types. How can I change alist to be the new type of list?
englishm has quit [Ping timeout: 250 seconds]
<bernardofpc>
the problem is how you use the returned value
<bernardofpc>
no alist
Gonzih has joined #ocaml
<bernardofpc>
"alist" is a dummy variable, so it has the type it has to have
<drbrule>
isn't the type for alist set by []?
<bernardofpc>
no
<drbrule>
the initial accumulator?
<bernardofpc>
well, officialy, yes
<bernardofpc>
but the problem is that [] can be of "any" list type
<bernardofpc>
the basic example is
<bernardofpc>
1 :: [] : int list
<drbrule>
right, so the first item sets it right?
<bernardofpc>
"1" :: [] : string lsit
<bernardofpc>
drbrule: precisely
<drbrule>
which is why I don't understand why it's working
<bernardofpc>
use a toplevel
<bernardofpc>
it will give you the type for intermediate stuff
englishm has joined #ocaml
<bernardofpc>
(the problem is the "in" in the end)
<ggole>
The names in (fun value key ...) is suspicious
<ggole>
key is the first arg
<drbrule>
It gives me This expression has type (int * StringMap.key) list but an expression was expected of type (string * int) list Type int is not compatible with type string
<bernardofpc>
ggole: right
<drbrule>
Yes, I see that issue, I've flipped them
<drbrule>
I thought that the first time List.append runs, it'll set the type of the accumulator to what I want
<drbrule>
yet, it doesn't and the error shows that.
<dsheets>
drbrule, as bernardofpc says, you need to inspect the body of the let .. in .. for an expression that causes the wrong type to be inferred. Perhaps pastebin the whole function/file and the error message?
ewd has quit [Remote host closed the connection]
<dsheets>
drbrule, also, you may want to use (key, value)::alist in the fold as List.append alist [(key, value)] is quite expensive ( O(1) vs O(n^2) )
<ggole>
Sounds like you just need to swap [(key, value)] to [(value, key)]
<Drup>
Unhammer: Well, you know what you have to do :3
<orbitz>
your mission is clear
NoNNaN has quit [Ping timeout: 264 seconds]
<Unhammer>
yup. add subscribe request to gmane.
<Unhammer>
(group not on gmane – bad sign)
NoNNaN has joined #ocaml
spip has joined #ocaml
spip has left #ocaml ["Konversation terminated!"]
ygrek has quit [Ping timeout: 245 seconds]
fold has quit [Ping timeout: 240 seconds]
_andre has quit [Quit: leaving]
parcs has joined #ocaml
mort___ has quit [Quit: Leaving.]
troutwine_away is now known as troutwine
pgomes has quit [Quit: Leaving]
Hannibal_Smith has quit [Quit: Sto andando via]
troutwine is now known as troutwine_away
englishm has quit [Ping timeout: 255 seconds]
malo has joined #ocaml
englishm has joined #ocaml
<drbrule>
Hey, anyone know how I could find someone competent in OCaml to give me tutoring (paid)? I'm not looking for someone to just feed me answers, but someone who can guide me when I get stuck. I really dislike having to ask for free help.
<Algebr>
When writing grammar for ocamlyacc, its easy when you have Foo of int, and hence you write %token <int> BAR, bu t what if you have Foo of int * string, how do you want the %token <what goes here?> BAR?
<Drup>
int * string ?
<Algebr>
Drup: just <int * string>?
<Drup>
well, I suppose, I don't know what you want to do exactly
<companion_cube>
drbrule: no idea, sorry, unless you know personnally some developer, or a nearby university provides OCaml lectures...
<drbrule>
companion_cube: yeah, that's the awkward part. I'm at a top uni, taking an ocaml class. The problem is the TA is only available 1 hr a week.
<drbrule>
strangely enough, it's literally impossible to find a tutor (much less a competent one) here during the summer for any price.
<drbrule>
I'd just grind away on my own, but it's a 5 week class, and I'm taking a second class on top of it, so my time is rather limited.
tane has quit [Quit: Verlassend]
<companion_cube>
would you learn from a book?
tane has joined #ocaml
<companion_cube>
I think that's how most people here learnt what they know
<companion_cube>
(that, and the internet in general ^^)
<drbrule>
yes, like I said, I am but it's slow...
alpounet has joined #ocaml
<drbrule>
ocaml is not very forgiving when it comes to explaining errors.w
<Anarchos>
drbrule what are your errors ?
<companion_cube>
indeed, there are a few mysterious errors for the beginner
<Anarchos>
drbrule i walways found the error reports very clear
<drbrule>
val expr : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Ast.expr <---that's the line with the error
<drbrule>
wierd, because I didn't even modify that line, it worked before.
<Anarchos>
drbrule compile ast.mli first
<drbrule>
ok
<drbrule>
I gotta run guys
Valdo has joined #ocaml
<drbrule>
Thanks for all the kind support!
<drbrule>
I'd hug you all and give you each a taco if I could.
<drbrule>
later
drbrule has quit [Quit: out]
<algoriddle>
hello, i have a very large recursive data type that I'd like to print in the toplevel. utop appears to have a limit on how much it dumps on screen, and after a while some values are just printed as "...". is this configurable?
<Anarchos>
algoriddle yes, but i can't remember where
troutwine is now known as troutwine_away
<algoriddle>
thanks, i found them: #print_depth and #print_length
<Algebr`>
for a .mll, say you have rule foo = parse. In one of the actions {}, can you do parse again? like say you had bar as l, then parse l.[3]
<Drup>
can't you do subrules instead ?
<Algebr`>
no aware of that, short example
<Algebr`>
not*
<Drup>
I just mean to use non-terminals in your rule, "foo : Bar baz* blop { .... }"
tane has quit [Quit: Verlassend]
<Denommus>
uh, I'm trying to do a Functor in the function level
<Denommus>
module type Functor = sig type 'a f (* ... *) end;;
<Denommus>
module ListFunctor: Functor = struct type 'a f = 'a list (* ... *) end;;
<Drup>
(keep going)
<Drup>
(this is going to end so well, I'll just fetch the pop corn, don't mind me)
Gonzih has joined #ocaml
<Denommus>
but when I try to use `fmap` (of the ListFunctor module, of course) on a list, it says the type of [1;2;3] is a int list, but it expects int ListFunctor.f
<Denommus>
how to use parametric polymorphism correctly, then?
<companion_cube>
you miss a constraint
<companion_cube>
module ListFunctor : Functor with type 'a f = 'a list = struct .... end
<Drup>
and to be honest, this is very disappointing, it's not even an (ocaml) fonctor.
<Drup>
:D
<Denommus>
Drup: OCamls functors are on the module category. I explicitly mentioned I was doing a functor in the function level
<Denommus>
s/OCamls/OCaml's/
<Drup>
no, I mean that you didn't implement your FooFunctor describing a (category theory/haskell) functor as an (ocaml) functor Functor over a base module Foo.
Gonzih has quit [Ping timeout: 250 seconds]
shinnya has joined #ocaml
<Drup>
(and you don't have any applicative and generative functors in your code)
<Drup>
(clearly not enough functors)
<whitequark>
"(clearly not enough functors)"
<whitequark>
out of context, that is *scary*
Eyyub has quit [Ping timeout: 255 seconds]
Algebr` has quit [Remote host closed the connection]
<Drup>
:D
<Drup>
When I did an internship with sam lindley, I asked him about some (category theory) functors in an article, thinking about ocaml functors, his answer was: Someone should write an article "Functors are not functors" or something like that.
<Denommus>
Drup: ah. I didn't think it would make sense to use functors to implement functors
<Denommus>
Drup: well, Haskell's functors are endofunctors on the category of functions and types. Haskellers just don't know that not every functor is like that
ollehar has quit [Ping timeout: 250 seconds]
<Drup>
(We should create a "Wadler point" for this quote :3)
olauzon has quit [Quit: olauzon]
jao has quit [Ping timeout: 240 seconds]
garth has joined #ocaml
troutwine_away is now known as troutwine
philtor has quit [Ping timeout: 245 seconds]
<Denommus>
hm, what's the equivalent of reduce/foldr in OCaml?
<companion_cube>
fold
<companion_cube>
sometimes, fold_left
<garth>
Can anyone tell me why I'm getting "ocamlfind: Package `camlp4' not found" when trying to install lwt when "opam install camlp4" returns "[NOTE] Package camlp4 is already installed (current version is 4.01.0)."?
<Denommus>
companion_cube: uh, unbound value
<companion_cube>
Denommus: what do you want to fold on?
<Denommus>
companion_cube: I want to join a list of lists
<Drup>
Denommus: as a side note, just put your join before the definition of <*> instead of abusing the recursive module x)
<rizo>
Doesn’t seem to be possible yet to actually cross-compile. I managed to intsall ocaml + opam on my RPi, but building takes ages and basic things (like ocamlfind) fail to compile
mort___ has joined #ocaml
philtor has quit [Ping timeout: 260 seconds]
tobiasBora has joined #ocaml
<Drup>
huum, ocamlfind should work, can you show the error message ?
<tobiasBora>
I would like to know, is there a way to package an executable for MacOsX and Windows which can run a bytecode program from a Linux plateform ?
<tobiasBora>
(I don't want the user to install ocaml by itself)