<Leo__>
looking for some help on Ocaml, can somebody help please?
<troydm>
Leo__: ask question
<troydm>
somebody might answer you
<Leo__>
ok thanks
<Leo__>
need to find :
<Leo__>
let foo : (float * (string * int) option list) list =
<Leo__>
just unable to get the right type example
<Leo__>
or can somebody put into words that I can understand the type?
<troydm>
list of list of option of tuple that is float * (string * int)
<troydm>
something like
<troydm>
[[(12.3, Some ("Hello",12))]]
<troydm>
sorry
derek_c has joined #ocaml
<troydm>
it's list of list of tuple of float and option tuple
<Leo__>
The intepreter said that there is an error:
<mcsquiggedy>
actually, it's a list of (tuple of float and (list of (option of tuple)))
<Leo__>
# let foo : (float * (string * int) option list) list = [[(12.3, Some ("Hello",12))]];; Error: This expression has type 'a list but an expression was expected of type float * (string * int) option list
<mcsquiggedy>
which, upon rereading, is a more explicitly associated version of what you said
<mcsquiggedy>
you want [12.3, [Some ("foo", 12)]
<mcsquiggedy>
*]
<Leo__>
I think that was very close. Still gav me an error
cdidd has quit [Remote host closed the connection]
<mcsquiggedy>
yeah, i forgot the terminating ]
<mcsquiggedy>
[12.3, [Some ("foo", 12)]] checks out
<Leo__>
Sure does. You are amazing! I have been trying for so long on this
<Leo__>
Thank you both for your help. greatly appreciate it.
derek_c has quit [Quit: leaving]
derek_c has joined #ocaml
<Leo__>
Hey Mcsuiggedy, would you beinterested on for hire on a contract basis?
Leo__ has left #ocaml []
derek_c has quit [Client Quit]
derek_c has joined #ocaml
derek_c has quit [Client Quit]
derek_c has joined #ocaml
<derek_c>
Hi guys, just curious: is it true that Ocaml is widely used in the financial industry?
ulfdoz_ has joined #ocaml
<mcsquiggedy>
derek_c: Jane Street Capital is well-known for using OCaml for their entire code base. I'm unaware of other companies using it.
ulfdoz has quit [Ping timeout: 240 seconds]
ulfdoz_ is now known as ulfdoz
yacks has joined #ocaml
<derek_c>
mcsquiggedy: oh right, I've heard of Jane Street. Thanks for the information!
groovy2shoes has quit [Quit: Computer has gone to sleep]
groovy2shoes has joined #ocaml
madroach has quit [Ping timeout: 248 seconds]
madroach has joined #ocaml
<derek_c>
can anyone please point me to an online tutorial that explains the usage of "Some"?
<mcsquiggedy>
it has the form None or Some foo, where foo has type 'a. So, for example, Some 5 is an int option, as is None.
adotbrown has quit [Ping timeout: 240 seconds]
travisbrady has joined #ocaml
<derek_c>
mcsquiggedy: thank you, but why would you want to use an option?
<derek_c>
I mean, how could you use it?
<darkf>
derek_c: for values that can either be something or nothing
<darkf>
like you would use nullable values in other languages.
<derek_c>
is there a sample program?
<mcsquiggedy>
one sec
<darkf>
derek_c: so, you might have a hashtable, and the getter function could return an 'a option where Some a means "here's the result, we found it" and None means "it wasn't there"
<darkf>
nothing hard about it
<mcsquiggedy>
let find_maybe elt lst = try let value = List.assoc elt lst in Some value with Not_found -> None
<darkf>
thats the same thing but with lists ^
<mcsquiggedy>
that function basically takes a lookup that throws an exception if the key cannot be found, and instead returns an option. That way, the type system forces anyone calling it to account for the possibility of a failed search.
<mcsquiggedy>
Because they'll be forced to handle both the Some x and None cases.
<mcsquiggedy>
apologies For erratic Capitalization. and punctuation
<derek_c>
thank you for that! not sure if I understood it.. I will try to write some simple programs!
travisbrady has quit [Quit: travisbrady]
nicoo has quit [Remote host closed the connection]
travisbrady has joined #ocaml
adotbrown has joined #ocaml
yacks has quit [Ping timeout: 240 seconds]
Submarine has quit [Ping timeout: 255 seconds]
groovy2shoes has quit [Quit: Computer has gone to sleep]
ahokaomaeha has joined #ocaml
derek_c has quit [Ping timeout: 255 seconds]
travisbrady has quit [Quit: travisbrady]
groovy2shoes has joined #ocaml
derek_c has joined #ocaml
ftrvxmtrx_ has joined #ocaml
yacks has joined #ocaml
groovy2shoes has quit [Quit: Computer has gone to sleep]
clan_ has joined #ocaml
yacks has quit [Ping timeout: 264 seconds]
andreypopp has joined #ocaml
yacks has joined #ocaml
mcsquiggedy has quit [Ping timeout: 255 seconds]
tac has joined #ocaml
Yoric has joined #ocaml
andreypopp has quit [Quit: sleep]
wormphlegm has quit [Read error: Connection reset by peer]
wormphlegm has joined #ocaml
andreypopp has joined #ocaml
Cyanure has joined #ocaml
ftrvxmtrx_ has quit [Quit: Leaving]
everyonemines has joined #ocaml
ftrvxmtrx_ has joined #ocaml
ttamttam has joined #ocaml
adotbrown has quit [Ping timeout: 246 seconds]
andreypopp has quit [Quit: sleep]
Cyanure has quit [Remote host closed the connection]
ttamttam1 has joined #ocaml
rossberg has quit [Ping timeout: 240 seconds]
rossberg has joined #ocaml
answer_42 has joined #ocaml
Yoric has quit [Ping timeout: 256 seconds]
ttamttam has quit [Remote host closed the connection]
mye has joined #ocaml
everyonemines has quit [Quit: Leaving.]
gour has joined #ocaml
tac has quit [Ping timeout: 245 seconds]
dabd_ has quit [Ping timeout: 252 seconds]
Yoric has joined #ocaml
Yoric has quit [Ping timeout: 252 seconds]
hkBst has joined #ocaml
hkBst has quit [Changing host]
hkBst has joined #ocaml
Yoric has joined #ocaml
Snark has joined #ocaml
AltGr has joined #ocaml
djcoin has joined #ocaml
andreypopp has joined #ocaml
mika1 has joined #ocaml
cago has joined #ocaml
mcclurmc has joined #ocaml
derek_c has quit [Quit: Lost terminal]
adrien_o1w has joined #ocaml
hkBst has quit [Ping timeout: 256 seconds]
hkBst has joined #ocaml
hkBst has quit [Changing host]
hkBst has joined #ocaml
hkBst has quit [Ping timeout: 276 seconds]
hkBst_ has joined #ocaml
mye has quit [Quit: mye]
hkBst_ has quit [Ping timeout: 256 seconds]
ahokaomaeha has quit [Quit: When I come back, please tell me in what new ways you have decided to be completely wrong.]
Cyanure has joined #ocaml
hkBst_ has joined #ocaml
hkBst_ has quit [Changing host]
hkBst_ has joined #ocaml
thomasga has joined #ocaml
cyball has joined #ocaml
hkBst_ has quit [Read error: Connection reset by peer]
hkBst__ has joined #ocaml
chattered has joined #ocaml
yacks has quit [Remote host closed the connection]
cyball has quit [Remote host closed the connection]
hkBst__ has quit [Read error: Connection reset by peer]
hkBst__ has joined #ocaml
yacks has joined #ocaml
chattered has quit [Remote host closed the connection]
yacks has quit [Ping timeout: 245 seconds]
ocp has joined #ocaml
mcclurmc has quit [Ping timeout: 272 seconds]
_andre has joined #ocaml
chambart has joined #ocaml
yacks has joined #ocaml
hkBst__ has quit [Ping timeout: 245 seconds]
Yoric has quit [Ping timeout: 257 seconds]
mye has joined #ocaml
mye_ has joined #ocaml
mye has quit [Ping timeout: 255 seconds]
mye_ is now known as mye
adrien_o1w is now known as adrien_oww
hkBst__ has joined #ocaml
cdidd has joined #ocaml
hkBst__ has quit [Read error: Connection reset by peer]
hkBst__ has joined #ocaml
yacks has quit [Ping timeout: 264 seconds]
nicoo has joined #ocaml
gour has quit [Disconnected by services]
gour_ has joined #ocaml
mye has quit [Quit: mye]
mcclurmc has joined #ocaml
<companion_cube>
Is 'parser' a builtin type of OCaml? My vim syntactic coloration seems to think so
Kakadu has joined #ocaml
<flux>
well, not really
<flux>
but ocaml comes with a campl4 extension that has that
<flux>
so that's why it has it
<flux>
I think it is quite rarely used..
Kakadu has quit [Client Quit]
<flux>
so if you're thinking of using that identifier, go ahead :)
adotbrown has joined #ocaml
<companion_cube>
oh, ok
<companion_cube>
thanks
<flux>
maybe if you think of doing a module that exposes identifier 'parser' in its interface, you might be doing a disservice to someone that might use the extension in future..
Yoric has joined #ocaml
chambart has quit [Ping timeout: 246 seconds]
<companion_cube>
hmm
<flux>
I think I probably would worry about it when it happens
<flux>
and then it would be a straight-forward search&replace..
ahokaomaeha has joined #ocaml
mye has joined #ocaml
andreypopp has quit [Quit: sleep]
yacks has joined #ocaml
andreypopp has joined #ocaml
leoncamel has joined #ocaml
chattered has joined #ocaml
<orbitz>
I've used parser a few times
<orbitz>
It's quick and easy
logicgeezer_ has joined #ocaml
andreypopp has quit [Quit: sleep]
<nicoo>
flux: The problem is that changing the interface breaks all code that relies on your module. If the module is meant to be open-sourced or used by other people, it might just be better to avoid collision from the start
ocp has quit [Ping timeout: 245 seconds]
<flux>
nicoo, well, at least they won't fail silently
<nicoo>
Yes, but it pushes the burden downstream or (worse) on the users who have your module's latest version
<flux>
nicoo, it's not optimal, but it's not a catastrophy :)
<flux>
chances are, if one writes a module, unless it is written to be used by others, it won't be..
<nicoo>
That's why I said « if [it] is meant to be open-sourced or used by other people »
<nicoo>
;)
chambart has joined #ocaml
andreypopp has joined #ocaml
mye has quit [Quit: mye]
chambart has quit [Ping timeout: 246 seconds]
yacks has quit [Quit: Leaving]
hkBst__ has quit [Ping timeout: 245 seconds]
hkBst has joined #ocaml
hkBst_ has joined #ocaml
hkBst has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Client Quit]
andreypopp has quit [Read error: Connection reset by peer]
yacks has joined #ocaml
andreypopp has joined #ocaml
mye has joined #ocaml
yacks has quit [Ping timeout: 240 seconds]
yacks has joined #ocaml
tane has joined #ocaml
andreypopp has quit [Quit: sleep]
chambart has joined #ocaml
andreypopp has joined #ocaml
UncleVasya has joined #ocaml
travisbrady has joined #ocaml
travisbrady has quit [Client Quit]
travisbrady has joined #ocaml
q66 has joined #ocaml
ttamttam1 has quit [Quit: ttamttam1]
darkf has quit [Quit: Leaving]
yacks has quit [Quit: Leaving]
ftrvxmtrx_ has quit [Quit: Leaving]
alxbl has quit [Changing host]
alxbl has joined #ocaml
yacks has joined #ocaml
mika1 has quit [Quit: Leaving.]
andreypopp has quit [Quit: sleep]
cago has left #ocaml []
hkBst_ has quit [Quit: Konversation terminated!]
ttamttam has joined #ocaml
ttamttam has quit [Client Quit]
travisbrady has quit [Quit: travisbrady]
Cyanure has quit [Remote host closed the connection]
leoncamel has quit [Ping timeout: 252 seconds]
ttamttam has joined #ocaml
travisbrady has joined #ocaml
leoncamel has joined #ocaml
Yoric has quit [Ping timeout: 276 seconds]
smondet has joined #ocaml
tac has joined #ocaml
sgnb has quit [Ping timeout: 256 seconds]
ftrvxmtrx has joined #ocaml
sgnb has joined #ocaml
sgnb has quit [Ping timeout: 245 seconds]
sgnb has joined #ocaml
sgnb has quit [Read error: Connection reset by peer]
adotbrown has quit [Ping timeout: 264 seconds]
ttamttam has quit [Quit: ttamttam]
sgnb has joined #ocaml
andreypopp has joined #ocaml
sgnb has quit [Ping timeout: 246 seconds]
sgnb has joined #ocaml
sgnb has quit [Ping timeout: 248 seconds]
osa1 has joined #ocaml
sgnb has joined #ocaml
Yoric has joined #ocaml
sgnb has quit [Ping timeout: 260 seconds]
notk0 has joined #ocaml
<notk0>
does ocamlbuild work automatically or I have to make a makefile for it?
<orbitz>
well, it doesn't respond to 'make' if that's what you mean
sgnb has joined #ocaml
<notk0>
orbitz: I did ocamlbuild and it gives me a syntax error from code I took from the internet
<notk0>
%start <int list> main
<orbitz>
the internet has known to be wrong at times
<notk0>
nothing looks wrong with this line
<notk0>
is there something wrong with it?
<f[x]>
it looks perfectly fine
<f[x]>
as fine as $^#&*(hdfs&*
<notk0>
f[x]: I had to use ocamlbuild --use-menhir for it to work
<notk0>
f[x]: as fine as what?
<f[x]>
as fine as that
<f[x]>
it all depends on the context
<notk0>
how cam I create a Lexer from the Lexing module on an file ?
<Qrntz>
oh, it's notk0 again. fascinating.
<notk0>
Qrntz: you know me?
<orbitz>
you talkin' to me?
<orbitz>
you must be talkin' to me
<orbitz>
maybe he knows you from ##c
sgnb has quit [Read error: Connection reset by peer]
sgnb has joined #ocaml
gour_ is now known as gour
<notk0>
orbitz: you know me as well?
<orbitz>
of course
<notk0>
orbitz: really? how?
<orbitz>
Because i'm a regular in ##c...
<notk0>
orbitz: I haven't been in c in a while tho
andreypopp has quit [Quit: sleep]
<orbitz>
you're there right now
<notk0>
orbitz: as in actively asking questions
<orbitz>
ok
<notk0>
what is the equivalent of List.map, but when I don't need the result?
<notk0>
for example to print a list, List.map (print_int) returns a unit list
<orbitz>
List.iter
<notk0>
thank you
<notk0>
finally it compiles!
<notk0>
ocamlbuild is magic
<notk0>
how can it figure so many things by itself?
<notk0>
aren't you guys impressed
* orbitz
shrugs, not really.
<notk0>
wait it doesn't compile :(
<notk0>
orbitz: why isn't there an equivalent in C?
<orbitz>
I believe it's called 'cmake'
chambart has quit [Ping timeout: 272 seconds]
<notk0>
orbitz: really? there exists such thing for C?
<notk0>
why does our teacher always make us write makefiles then
<orbitz>
Because being able to write makefiles is a good skill
<orbitz>
I use Makefiles over ocamlbuild, but i'm a masocist
<notk0>
oh I see
<notk0>
I have this function let print_int_list = List.iter (print_int)
<notk0>
I want it to write a newline at the end, can I still do it in one line?
<orbitz>
Sure
<notk0>
hm
<notk0>
orbitz: I forgot the syntax, is it let a = fun arg => ?
<orbitz>
->
<pippijn>
notk0: drop the habit of putting () around argument lists
<notk0>
pippijn: ok I will
<notk0>
let print_int_list = fun l -> ( ( List.iter (print_int) l ) ; print_newline )
<pippijn>
wow.. more ()
<orbitz>
that doesn't make any sense
<notk0>
what is wrong with it I don't understand
<notk0>
oh
<notk0>
hm
<pippijn>
that really doesn't make much sense
<notk0>
hm
<notk0>
for an argument l. I do list.iter on the list, then print_newline ?
<notk0>
and it gives unit as the result?
<pippijn>
what is the type of print_newline?
<orbitz>
let wahteve l = List.iter blah l; print_newline ()
<notk0>
pippijn: it's unit I think
<pippijn>
no
<orbitz>
no, print_newline is unit -> unit
<pippijn>
it's unit -> unit
<notk0>
oh
<notk0>
you have to give it a unit argument I understand thank you
<pippijn>
yes
<notk0>
is this a good way to do it or there are better ways?
<pippijn>
to print a newline to stdout?
<orbitz>
i just gave you the way
<notk0>
let print_int_list = fun l -> List.iter print_int l ; print_newline()
<notk0>
so = fun l is useful only when you return a function?
<orbitz>
that isn't what i gave you
<pippijn>
let foo = fun a -> fun b -> c -> blah
<notk0>
orbitz: I know, you removed the fun l and put the argument before
<pippijn>
this can be written shorter as
<pippijn>
let foo = fun a b c -> blah
<pippijn>
and even shorter as
<pippijn>
let foo a b c = blah
<notk0>
I see
<pippijn>
that first one was supposed to be: let foo = fun a -> fun b -> fun c -> blah
<pippijn>
it's syntax sugar and all means the first version
ttamttam has joined #ocaml
peddie has left #ocaml []
<pippijn>
you should usually prefer this form: let foo a b c = blah
<pippijn>
as orbitz said
<notk0>
oh ok
<notk0>
thank you
<notk0>
let print_int_list l = List.iter ( fun i -> print_int i; print_string " " ) l ; print_newline() to put spaces
<notk0>
is this good?
<pippijn>
looks fine tome
<pippijn>
to me
<notk0>
in this case I have to use ( ) right?
<orbitz>
yes
<notk0>
ok thank you
<orbitz>
and i'd do print_newline ()
<notk0>
done :P
<pippijn>
consistency is very important for readability
<pippijn>
so print_newline () is better than print_newline()
<notk0>
well I don't have much experience in ocaml, and I haven't use it in a while
yacks has quit [Remote host closed the connection]
sgnb has quit [Read error: Connection reset by peer]
thomasga has quit [Quit: Leaving.]
sgnb has joined #ocaml
sgnb has quit [Read error: Connection reset by peer]
AltGr has quit [Quit: Konversation terminated!]
djcoin has quit [Quit: WeeChat 0.3.9.2]
silkwood has joined #ocaml
ttamttam has quit [Remote host closed the connection]
<adrien>
ocp-build and obuild, who's going to review them? :P
mye has quit [Quit: mye]
<orbitz>
ocp? like the evil corporation in robocop?
<adrien>
ocamlpro
<adrien>
whether ocp-build is evil or not, I don't know for sure ;p
<orbitz>
give it time, they'll be building robotic cops in no time, taking over detroit
<gour>
obuild looks interesting...
<gour>
anyone tried to 'teach' tup to build ocaml projects?
dwmw2_STN is now known as dwmw2_gone
notk0 has quit [Remote host closed the connection]
bholst has quit [Remote host closed the connection]
UncleVasya has quit [Quit: UncleVasya]
bholst has joined #ocaml
silkwood has quit [Ping timeout: 264 seconds]
andreypopp has quit [Quit: sleep]
metasyntax has quit [Quit: Leaving]
leoncamel has quit [Ping timeout: 240 seconds]
Cyanure has joined #ocaml
chambart has joined #ocaml
<bholst>
hi
<bholst>
could somebody recommend me a text about the evaluation strategy of ocaml
osa1 has quit [Ping timeout: 264 seconds]
<thelema_>
you'll probably have to read the source for the compiler to understand the evaluation strategy of native compiled ocaml.
<thelema_>
The bytecode should still follow the CAML design; you'll have to look up Xavier Leroy's paper on it
thelema_ has quit [Remote host closed the connection]
tac has quit [Ping timeout: 245 seconds]
thelema has joined #ocaml
derek_c has joined #ocaml
<derek_c>
Could anyone tell me why ocaml might be considered of a higher educational value than Haskell? Our university is using Ocaml to teach functional programming, and I'm not sure why.
<thelema>
derek_c: easier to transition to non-functional languages
<bholst>
thelema: thanks
<thelema>
bholst: you're welcome
emmanuelux has joined #ocaml
<bholst>
derek_c: Well, at the moment I'd say neither Haskell nor OCaml is of higher educational value.
<derek_c>
thelema: thanks! though I think "from non-functional languages" makes more sense
<thelema>
derek_c: a sly dig at ocaml being broken?
<orbitz>
thelema: no, read what you said again
<bholst>
is it?
<thelema>
using ocaml makes it easier for students to transition to non-functional languages, whereas transitioning form haskell to an OO language will be ... difficult
<orbitz>
ah
<orbitz>
myself and derek_c were thinking you mean it is easier for students who are familiar with imperative langauges to transitio nto FP because of ocaml
<ben_zen>
well, Haskell and OCaml are both very strong languages; OCaml, however, has a much closer relation to its underlying imperative language (C) than Haskell does to ... anything.
<thelema>
ben_zen: only that OCaml is surprisingly close to the hardware, while I see a bunch of decisions around tooling/compilation coming from the C universe (which we're paying for now, and trying to fix), I wouldn't say that C is the underlying imperative language for OCaml
<ben_zen>
thelema: true.
mcclurmc has joined #ocaml
cyball has joined #ocaml
derek_c has quit [Ping timeout: 252 seconds]
<ben_zen>
the compilation is surprisngly opaque, for how powerful the language is; I'm working with OcURL at the moment, and it wouldn't build if I didn't move the contents of the curl/ folder up into the main ocaml libraries folder.
derek_c has joined #ocaml
<ben_zen>
(the project I'm writing, that is, wouldn't build.)
<thelema>
ben_zen: compiling OCaml is almost identical to compiling C, except for the extra type saferty
<thelema>
you probably just needed an -I +curl
<ben_zen>
hm, probably.
<thelema>
+ is magic for `ocamlc -where`, i.e. the main ocaml library dir
ahokaomaeha has quit [Ping timeout: 252 seconds]
Submarine has quit [Quit: Leaving]
<ben_zen>
ahhh
derek_c has quit [Ping timeout: 245 seconds]
answer_42 has quit [Ping timeout: 276 seconds]
<thelema>
the usual fix for this is to use ocamlfind, which will manage these include dirs and even dependencies between projects
tac has joined #ocaml
Snark has quit [Quit: Quitte]
mcsquiggedy has joined #ocaml
andreypopp has joined #ocaml
tac has quit [Quit: Page closed]
Yoric has quit [Ping timeout: 246 seconds]
chambart has quit [Ping timeout: 246 seconds]
gour has quit [Quit: WeeChat 0.4.0]
<orbitz>
diml: Great Core release email! Lots of great stuff in there
travisbrady has quit [Quit: travisbrady]
chambart has joined #ocaml
Yoric has joined #ocaml
Cyanure has quit [Remote host closed the connection]
adotbrown has joined #ocaml
Yoric has quit [Ping timeout: 252 seconds]
mcclurmc has quit [Ping timeout: 264 seconds]
tane has quit [Quit: Verlassend]
leoncamel has joined #ocaml
andreypopp has quit [Quit: sleep]
sgnb has joined #ocaml
tac has joined #ocaml
travisbrady has joined #ocaml
leoncamel has quit [Ping timeout: 276 seconds]
chambart has quit [Ping timeout: 246 seconds]
leoncamel has joined #ocaml
smondet has quit [Ping timeout: 264 seconds]
tac has quit [Ping timeout: 245 seconds]
m4b has joined #ocaml
<m4b>
hello: I'd like to use the Map module, and I'd like the keys to be regular ints; right now I use: module M = Map.Make(Int32), which obviously gives me keys which are int32s; but I can't seem to figure out the syntax for passing the functor Map.Make regular ints, if this is possible.
<thelema>
m4b: module M = Map.Make(struct type t = int let compare = compare end)
<thelema>
is much faster if you provide an int-specific comparison function, such as: let compare (x : int) y =
<thelema>
if x > y then 1
<thelema>
else if y > x then -1
<thelema>
else 0
<dsheets>
thelema: compare = ( - ) ?
<thelema>
dsheets: this one is faster. And correct for comparing max_int with min_int
<dsheets>
faster to branch? i concede the min_int/max_int problem
* thelema
is benchmarking now
<thelema>
I thought I had (-) in my int compare benchmark, but apparently I didn't
<m4b>
thelema: thank you for the prompt response! Unfortunately I'm not familiar with struct syntax, and i'm getting a syntax error for when I enter exactly what you have typed, except replacing compare with the definition you supplied
<dsheets>
well, as you point out, ( - ) is not correct for the whole domain
<m4b>
alternatively, the reason I attempted to use the map module is because I previously had Hashtbl's implemented for the memory of a machine; it mapped addresses(integers) to arrays of program instructions; the problem however was that the hashtable's in ocaml when removed, aren't really removed, and revert to the previous copy, which leads to many problems; so I wanted to use the map since it doesn't have this behavior; are there any
<m4b>
other suggestions for a suitable data structure?
q66 has quit [Quit: Quit]
<dsheets>
m4b: what do you mean by revert? Were you using "add" or "replace"? If you want k-v pairs, you can enforce 1 value wby using "replace"
<dsheets>
m4b: replace really is mutation whereas the Map module really implements immutable maps by sharing parts of a search tree
<m4b>
dsheets: the spec of the machine requires a deallocation opcode; it finds the identifier for the program array, and removes it; as such I can't necessarily rely on replace
<thelema>
m4b: try the non-optimized compare
<dsheets>
m4b: i'm not sure i follow your issue… if you use "replace" to set pointers and "remove" to dealloc, what is the problem? maybe i'm just misunderstanding
<m4b>
thelema: I would but I can't get the module to run because I am not familiar with the syntax, and I'm getting an error. I apologize if this sounds stupid, but I'm not familiar with struct syntax; I tried in the toploop: module M = Map.Make(struct type t = int let compare = <that definition inline> end) --- and received Syntax error: ')' expected, highlighed '(' might be unmatched
leoncamel has quit [Ping timeout: 252 seconds]
<thelema>
dsheets: I take that back, subtraction is a bit faster:
<m4b>
dsheets: it is not against spec for a program can allocate over an already allocated array; if that array is then deallocated, the previous array will remain;
<thelema>
For comparing 1000 pairs of random integers
<thelema>
subtraction compare (4.03 us) is 14.4% faster than
<thelema>
BatInt.compare (4.71 us) which is 1.3% faster than
<dsheets>
m4b: right… so when you allocate, why can't you use "replace" instead of "add"?
<thelema>
m4b: dsheets is right; using Hashtbl.replace instead of Hashtbl.add should fix your issue with hashtbl.
<m4b>
dsheets,thelema: that is a good point; let me check my code and see if that was what I was doing.
<dsheets>
thelema: ok, that makes sense re: compare with int ops… but is still broken if you need the full domain and your compare solution is fully correct
<m4b>
So I have two versions of this program; one implements the memory as a 2d array, which expands with to_list, from_list (ugh, I know), and even worse, represents deallocs as a 0-ary type constructor FREE; its ugliness however does not affect that it runs a large 15 megabyte 32-bit array of instructions correctly (albeit slowly); the hash table version however, continues to give me array out of bounds access problems, and I am almost
<m4b>
certain this is caused by the memory of the hash-table; changing the malloc function to replace instead of add still gives this error, unfortunately.
<dsheets>
hmmm that doesn't really sound like your old values are coming back but something else… can you post code?
<dsheets>
again, unless i misunderstand something like your writing every key in the hashtbl with a length-1 array or something
<m4b>
yes I can; I've also just printed the mallocs and allocs with address numbers, which I can post too
<m4b>
if you want me to comment the code a little, might take some time
<dsheets>
uggh in 2013, i shouldn't still be experiencing kernel panics under linux in 6mo hardware… not cool
<dsheets>
supposedly stable kernel, too
<dsheets>
i blame the GPU industry
<m4b>
code is at: dpaste.com/901250
<m4b>
i wish I could get the binary that its out of bounding on, but its 15 megs
<m4b>
it might be a bit much to take in; but the memory functions start on line 293, I'm getting an; some error output of all the mallocs with the array identifier at: dpaste.com/901270/