__DL__ changed the topic of #ocaml to: OCaml 3.09.0 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
whit has quit []
m3ga has joined #ocaml
smimou has quit ["bli"]
Raziel has quit ["Yo soy goma. Tú eres cola."]
code17 has joined #ocaml
zigong has joined #ocaml
code17 has left #ocaml []
gim has quit ["sploch"]
pango__ has joined #ocaml
pango__ is now known as pango
code17 has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
pango_ has quit [Read error: 110 (Connection timed out)]
zigong has quit [Read error: 110 (Connection timed out)]
code17 has quit ["Changing server"]
code17 has joined #ocaml
code17 has left #ocaml []
mhall has joined #ocaml
<mhall> Is there anybody here that can help with an SML function. I know it's ECHAN but the language is similar. http://pastebin.ca/32319
mhall has left #ocaml []
demitar__ has joined #ocaml
shirogane has joined #ocaml
demitar_ has quit [Read error: 110 (Connection timed out)]
yozora has joined #ocaml
yozora has left #ocaml []
m3ga has joined #ocaml
Snark has joined #ocaml
shirogane has quit [Remote closed the connection]
Raziel has joined #ocaml
_JusSx_ has joined #ocaml
lightstep has joined #ocaml
<lightstep> does ocaml support recursive modules?
<flux__> I think only within a single compilation unit
<lightstep> can a compilation unit contain several files?
<flux__> I don't think so.
<flux__> but there are ways to go around that problem, for example with the object system
<lightstep> to emulate a structure with an object?
<flux__> or just make records of functions
<lightstep> my prblem is that my types refer to types in other modules
revision17_ has joined #ocaml
Skal has joined #ocaml
Revision17 has quit [Read error: 110 (Connection timed out)]
__DL__ has joined #ocaml
MisterC has joined #ocaml
MisterC has quit [Read error: 104 (Connection reset by peer)]
Skal has quit [Read error: 110 (Connection timed out)]
lightstep has quit ["what a wonderful hat"]
m3ga has quit ["disappearing into the sunset"]
smimou has joined #ocaml
<Mitar> why this does not work (i would like to substract all other numbers from first number): (List.fold_left ( - ) List.hd(nargs) List.tl(nargs)
<Mitar> let nargs = [5;4;5] in List.fold_left ( - ) List.hd(nargs) List.tl(nargs)
<Mitar> but let nargs = [5;4;5] in List.fold_left ( - ) 6 nargs works
<vodka-goo> you have a wrong syntax for application
<vodka-goo> this is curryfied
<vodka-goo> let nargs = [5;4;5] in List.fold_left ( - ) (List.hd nargs) (List.tl nargs)
<vodka-goo> this was not curryfied
<Mitar> aaghh
<Mitar> yes
<Mitar> how can i build a match pattern which would decompose a list into a head and tail, but would require that the list has at least two elements
<Mitar> i have fst :: snd :: tail and then use fst and snd :: tail later on
<vodka-goo> match x with | x::y::tail -> x,y::tail
<Mitar> is there something nicer?
<vodka-goo> patterns need not be only 1-level deep
<vodka-goo> Mitar: I think that's the best way
<vodka-goo> you can use a "when" construct or an assert but these approaches will lead to possible problems
<Mitar> like?
<vodka-goo> the when construct breaks the coverage analysis of the pattern matching
<vodka-goo> the assert makes it more complicated (if you need it) to manage the case where the list is too short
<Mitar> thanks for explanation
<vodka-goo> the (pure) pattern matching is your friend, helps you write good software
<Mitar> i know, that's why i stayed with first solution
<Mitar> but sometimes it is a nusiance ...
<Mitar> args_eval gamma env = function Null -> Null | Pair (e1, e2) -> Pair (eval gamma env e1, args_eval gamma env e2) | _ -> error
<Mitar> args_to_list = function Null -> [] | Pair (e1, e2) -> e1 :: args_to_list e2 | _ -> impossible_error
<Mitar> for example
<Mitar> in this case
<Mitar> i call it with build_args vars (args_to_list ...)
<Mitar> ups
<Mitar> with args_to_list (args_eval gamma env e2)
<Mitar> so there is no way that it would be something else than Null or Pair in args_to_list
<Mitar> but i still need a _ case
<Mitar> why?
<vodka-goo> if you want this function to be called only under that assumption put an assert false instead of the impossible_error thing
<vodka-goo> that my politic at least ;)
<vodka-goo> Mitar: why ? ocaml doesn't know that you'll only call it from build_args
<Mitar> but i do call it only from there
<Mitar> i think that it should work without _
<Mitar> but in the case i would use it somewhere else too it should complain
<Mitar> but if i use it in just this case it should not
<flux__> infact that would be great if ocaml could figure that out, however that doesn't work without whole-program-compilation
<flux__> because the code that calls the function might be compiled later
<flux__> hmm, maybe such restrictions could go with the function's signature..
<Mitar> than make in multiple-pass compilation :-)
<flux__> your code could even be in a library, and the source for it not available at the point of compiling the later code
<Mitar> that's true ...
<Mitar> ok, so othere than assert false, is there anything else what could make it clearer?
<vodka-goo> type system cannot do everything, even if in some cases it's sad :(
<flux__> you can just disable the warning, no?
<Mitar> disable the warning? how?
<Mitar> (i am still a beginner)
<flux__> don't the warnings have their associated class with them, nowadays
<vodka-goo> I don't think it's a good idea to disable coverage warning
<Mitar> and how would i make this into function signature?
<flux__> it's still easier to just write the impossible cases
<Mitar> yes, i also think that impossible case is better
<vodka-goo> Mitar: can you paste some code to pastebin, I'd like to see if it's possible to use polymorphic variants
<Mitar> but it would be even better if there would be no need for this
<Mitar> and which pastebin is ocaml friendly?
<vodka-goo> anyone, don't care
<Mitar> open to any imprevements
<Mitar> or ideas for cleaner code
<Mitar> i have to functions: to_int = function Int e -> e | _ -> error and to_bool = function Boolean e -> e | _ -> error
<Mitar> is there a way to make one, which would get e and a type (how can put a type as an parameter) and it would return the ocaml value of this type
<Mitar> for example the call could be (if this is possible): to_native Int e
<vodka-goo> Mitar: why don't you use real lists for functions which expect/return lists ?
<vodka-goo> eval_args could be scheme list -> scheme list right ?
<vodka-goo> then args_to_list is useless
<Mitar> you mean eval_args could be scheme list -> ocaml list?
<Mitar> this is will be optimizations later on
<Mitar> it is true
<Mitar> the problem is
<vodka-goo> "scheme" was meant to be the time of your scheme terms representation
<Mitar> that i defined macro with expr as a parameter
<Mitar> and not as expr list as a parameter
<vodka-goo> it's not about optimizing it's about putting as much of the semantics as possible in the type
lightstep has joined #ocaml
<lightstep> is there a full explanation of the parser syntax somewhere?
Boojum has joined #ocaml
<lightstep> i want to know all the features, not just look at some partial tutorial
<lightstep> since most of them use unexplained "magic" features
<Mitar> no, eval_args can be scheme -> scheme list and not scheme list -> scheme list
<Mitar> and i will make it scheme -> scheme list later on
<vodka-goo> there are not so much hidden or magic features, but I believe it's better to start with the basics
<vodka-goo> Mitar: ok
<Mitar> (or i do not know what exactly you are trying to tell me)
<vodka-goo> Mitar: the point was (and you got it) that if it returns a list, you don't need arg2list.. but I don't understand why you don't want to do it now
<vodka-goo> anyway, let's go to work
<Mitar> but for now the defintion of the scheme functions (macro, procedure ...) get one expr (that is your scheme) and not a expr list (or scheme list)
<Mitar> because the professor gived us such defintions for macro, procedure ...
<Mitar> and i would like first to finish this as he envisioned
<vodka-goo> you do not choose the types, ok :(
<Mitar> and than i will go around and change it to my taste
<vodka-goo> I understand
<vodka-goo> have fun
<lightstep> vodka-goo, (if you're still here), i can't find, for example, a list of legal patterns. just a few moments ago i found that ''0'..'9' is a valid pattern
<lightstep> for a char stream
<Mitar> (yes, it is really fun, because i have to make a ocaml list from scheme again when i am evaluating the scheme functions)
<vodka-goo> lightstep: nice point ;) I actually discovered that very recently, hadn't read it anywhere
<lightstep> and i don't feel like searching for the source code and reading it
<vodka-goo> lightstep: but frankly ocaml isn't like perl with many alternative syntax, you do most with the basic constructs
<Mitar> (and i already changed one type, i changed True and False types to one Boolean of bool type, so that i can use it as a boolean in ocaml code)
<lightstep> vodka-goo, i actually want something like [< x = not_something_of [1;2;3] >], and i don't know whether it's available
<lightstep> or what are the ways to implement it, if not
<vodka-goo> lightstep: (quite sure) unavailable
<vodka-goo> the idea is that patterns are not "runtime" things (roughly)
<vodka-goo> lightstep: but you can do match x with 1 | 2 | 3 -> ...
<vodka-goo> but there's no solution if want [1;2;3] to be a variable
<lightstep> it's constant in my case
<vodka-goo> so I guess the pattern alternative is what you need
<lightstep> part of the problem is i have a wrong mental model of stream pattern matching
<Mitar> how could a check if all values in a list have the same value?
<Mitar> (integer value)
<Mitar> (the question is, is there any builtin function or something in List which would help me with that)
<Mitar> so some function which would take a two argument predicate p and a list [a1, a2, a3 ... an] and would return a1 p a2 && a2 p a3 && a3 p a4 ...
<Mitar> or, how would i name such function?
<flux__> List.for_all ?
<lightstep> how can i tell ocaml to enable stream syntax?
<vodka-goo> match x with [] -> true | h::t -> List.for_all ((=) h) t
<Mitar> this works with =, but what about any other transitive predicate?
<lightstep> Mitar, if it is transitive and commutative, it still works
Boojum has quit [Read error: 110 (Connection timed out)]
<lightstep> if the predicate is only transitive, vodka-goo's expression is a stronger property than yours
<Mitar> hmm, for example if i want to test if elemenets are in increased order, than i could just use < as a predicate on my function
<vodka-goo> Mitar: then use a fold_left
<Mitar> with vodka-goo's i would just know that the first is small than all others
<Mitar> fold_left? cannot, because predicate return boolean, and the other elements are ints, so it does not work
<vodka-goo> fst (List.fold_left (fun v elt -> match v with (_,None) -> true | (b,Some prev) -> (b && your_relation prev elt),Some elt) (true,None) list))
<Mitar> ugh
<pango> lacks evaluation shortcuts ;)
<Mitar> how can i make a pattern which would mean: for any list
<lightstep> how can i make the interpreter accept [<>] ?
<Mitar> _ list?
<lightstep> Mitar, just _
<Mitar> that would mean anything
<pango> Mitar: | [] | h :: q ->
<lightstep> Mitar, unless you mean the type, then its 'a list
<Mitar> a type
<pango> ah, doesn't work
<Mitar> i have: fst :: snd :: tail -> ... | for_other_lists -> error
<Mitar> what should be in place of for_other_lists
<lightstep> Mitar, just that
<Mitar> i could use _ but this would mean there could be anything
<Mitar> 'a list ?
<lightstep> then the list would be bound to the variable "for_other_lists" in the expression "error"
<Mitar> but if the function would be called with anything else it would also be bount to that vairable
<pango> | [] | _ :: _ ->
<Mitar> but i would like that this would be static typing
<Mitar> and not dynamic
<Mitar> (so that compiler would notice i called this funcion on something that is not list)
<lightstep> Mitar, it does
<pango> Mitar: since the first case matches 'a list, the parameter will be an 'a list, or it would be a type error
<lightstep> Mitar, even if you use _, the compiler will still force it to be a list
<Mitar> so there cannot be multiple types?
<lightstep> correct
<lightstep> can anyone help me with my problem? (sorry for bugging)
<pango> haven't played with streams yet
<vodka-goo> Mitar: when you want "multiple types" you pack them in a sum type A of t1 | B of t2
<Mitar> yes ...
<Mitar> thanks
<vodka-goo> lightstep: don't remember exactly, but ocamlc -pp something ;)
<lightstep> thanks
<vodka-goo> lightstep: don't remember exactly, but ocamlc -pp pa_op maybe ?
<vodka-goo> man camlp4
<Mitar> list_for_all_trans p = function
<Mitar> fst :: snd :: tail -> (p fst snd) && (list_for_all_trans p (snd :: tail))
<Mitar> | _ -> true
__DL__ has quit ["Bye Bye"]
<lightstep> hmm. "ocamlc -pp ocamlp4o" works, but i can't find a way to launch the repl with it
Skal has joined #ocaml
<pango> Mitar: or http://pastebin.com/448234
<Mitar> ugh, that is hard
<Mitar> and the difference?
<Mitar> (i have not managed to eat it through yet)
<pango> deconstruction of the two first elements are serialized
<Mitar> and why is that better?
<pango> don't know if it's "better", just giving an alternative
<pango> it's probably slightly faster, since it does a little less work in the loop (unless the compiler is smarter than I tought)
<Mitar> aha, thanks
<Mitar> but i will stay with mine, it is clearer
<pango> another thing that you can do is
<pango> let rec list_for_all_trans p = function
<pango> | fst :: (snd :: tail) as list ->
<pango> (p fst snd) && (list_for_all_trans p list)
<pango> | _ -> true
<pango> (I hope I didn't forget a () )
<pango> no, seems to work
<Mitar> are you sure?
<Mitar> list_for_all_trans ( = ) [1 ; 1 ; 1] does not work
<pango> mmh tested in emacs' ocaml-mode, and it seems it didn't evaluate my last definition :/
<pango> ok, so
<pango> let rec list_for_all_trans p = function
<pango> | fst :: ((snd :: tail) as list) ->
<pango> (p fst snd) && (list_for_all_trans p list)
<pango> | _ -> true
<Mitar> still nothing
<pango> works for me that time
<Mitar> list_for_all_trans ( = ) [1 ; 1 ; 1] does not work
<pango> # list_for_all_trans ( = ) [1;1;1] ;;
<pango> - : bool = true
<Mitar> agh
<Mitar> yes
ellisonch has joined #ocaml
lightstep has quit ["leaving"]
<Mitar> is there a function which would deeply go through and tell if two values are equal?
<pango> lists don't allow random access, so I'd say no
<pango> for this you'd want hash tables, or other datastructures
Skal has quit ["Client exiting"]
<Mitar> so there is nothine like equal(v1, v2)
<pango> oh, that the whole structures are equal ? = does this
<Mitar> ocaml thinks this is an integer equality
<Mitar> (i get such error)
<pango> = is polymorphic
<pango> so it should work; the only thing = doesn't know how to handle right are cycles
<Mitar> i get "This expression has type Minscheme.expr but is here used with type int" at e -> e line
<Mitar> (Null and Pair are parts of Minscheme.expr)
<pango> I don't see what's wrong... to_expr is probably too polymorphic (compiler can only infer it's 'a -> 'a type)
<pango> that should be ok, but maybe it hides some errors, try specifying e:expr anywhere in to_expr definition
<Mitar> why to_expr = function
<Mitar> expr e -> expr e
<Mitar> does not work?
<pango> because it's not ocaml syntax
<Mitar> i would like that e is of type expr
<pango> let to_expr = function e:expr -> e
<Mitar> why this works: to_int = function
<Mitar> Int e -> e
<Mitar> | _ -> error
<pango> the presence of Int constructor is enough to infer that the parameter is an expr
<pango> there's no such clue in the to_expr definition
<Mitar> aha, but expr does not have constructor
<Mitar> e:expr -> e does not work either
<Mitar> (syntax error)
<pango> parenthesis again... function (e:expr)
<Mitar> is it possible to write this better: Procedure (e1, e2, e3) -> Procedure (e1, e2, e3)
<pango> Procedure _ as p -> p
<Mitar> thanks
<Mitar> for everyhing
<pango> np
<Mitar> no idea
<Mitar> i get "This expression has type Minscheme.expr but is here used with type int" around [args; args]
<Mitar> list_eq1 and list_eq2 are my objects i want to compare
<Mitar> (there will be more than two in list, but this is an example)
<Mitar> and we have defined that procedure, macro and builtin are the same if == returns true
<pango> scheme_equals has the wrong type, it takes a tuple
<Mitar> how can i match two parameters at the same time?
<pango> and list_for_all_trans expects a 'a -> 'a -> bool function
<pango> don't use function keyword, let rec scheme_equals e1 e2 = match e1, e2 with ...
<Mitar> aa
<Mitar> thanks again
<Mitar> hm but it still does not work
<pango> personally I find the function keyword more confusing than using match, and it doesn't save much keyboard typing
<Mitar> "This expression has type Minscheme.expr but is here used with type int" at [list_eq1; list_q2]
code17 has joined #ocaml
<pango> what's the infered type of list_for_all_trans ( scheme_equal ) ?
<pango> (btw there the parenthesis shouldn't be necessary; they're necessary for infix operators)
<Mitar> (i have them because it makes code look the same, as i use some infix operators higher in code)
<pango> but infix is a very special case
<Mitar> the problem is in to_expr = function
<Mitar> (e:expr) -> e
<Mitar> hmm
<Mitar> i will make a big reworking of code
code17 has quit [Remote closed the connection]
code17 has joined #ocaml
Skal has joined #ocaml
Skal has quit [Read error: 104 (Connection reset by peer)]
<Mitar> what does == compare?
<Snark> (==);;
<Snark> - : 'a -> 'a -> bool = <fun>
<Mitar> and difference witj =
Skal has joined #ocaml
<Smerdyakov> I'm not sure how precisely specified (==) is. It's "physical equality," and so its meaning depends on compilation strategies -- or perhaps the OCaml manual expresses everything precisely enough somewhere.
<Smerdyakov> For boxed types, it ends up being a "pointer equality" operation.
<Smerdyakov> (=) is the more-mathematically-common structural equality, though it has the disadvantage of uncertain termination for some types and values.
<flux__> hmm.. a cmt (comporable memory transaction) library for c, and there's already stm for haskell, I wonder if anyone's working on one for ocaml
Snark has quit ["Leaving"]
flux__ has quit [Remote closed the connection]
code17 has quit ["leaving"]
flux__ has joined #ocaml
<Mitar> vars_list = function
<Mitar> Null -> []
<Mitar> | Pair (e1, e2) -> e1 :: (args_list e2)
<Mitar> | _ -> error
<Mitar> how can i make a pattern so that second match would match only type Pair (Symbol, ...)
<Mitar> vars_list = function
<Mitar> Null -> []
<Mitar> | Pair (e1, e2) -> (match e1 with Symbol s -> s | _ -> error ("")) :: (args_list e2)
<Mitar> | _ -> error
<Mitar> does not work
<Mitar> ahh, args_list instead of vars_list
<Mitar> :-)
<Mitar> ok, and is there a way to write this better?
<vincenz> od
<Mitar> od?
<Smerdyakov> | Pair (Symbol s, e2) -> ...
<Mitar> so simple ...
kingmike has joined #ocaml
<kingmike> Hi ! How can I access devices ? i.e. open my cdrom drive ? Is there a way to write it so that it works in the same way on windows and Unix ?
<Mitar> is there some other way to pass a contructor than to make such function: to_pair e1 e2 = Pair (e1, e2)
<kingmike> What do you mean ?
<kingmike> In a module ?
<Mitar> no no
<Mitar> i would like to pass to List.right_fold a function
<Smerdyakov> Mitar, not that I know of.
<Mitar> and build a tree of a list
<Smerdyakov> kingmike, I don't think OCaml or its standard library has any concept of devices.
<kingmike> Smerdyakov : ok, thanks, I thing I have to use the C interface
<Smerdyakov> kingmike, however, there is a concept of file paths. Don't both of those allow expressing "the CD-ROM drive's root" as a file path?
<kingmike> No, I want to gain raw access to my drive, so I can open and close it. No troyans have been written in OCaml yet, I want to implement a very simple one that constantly opens and closes a cdrom drive
<Smerdyakov> You are French?
<kingmike> yes, why ?
<Smerdyakov> I thought the French preferred mathematics to cracking! :D
<kingmike> I love mathematics, but I like having some fun between two topological problems :-)
shirogane has joined #ocaml
<vincenz> I doubt ocaml is suited for a troan
<vincenz> trojan even
<kingmike> thats what I want to see
<vincenz> you'd be writing all the system stuff in c
<vincenz> ocaml is made to be platform INDEPENDENT
<vincenz> trojans are inherently platform dependent
<vincenz> go for a language that offers more system hooks
<kingmike> thats right, but if I implement some of the parts in C, then interface this with the "core" code in OCaml, it can be done ?
<vincenz> your ocaml code would be empty
<vincenz> besides you'd have to have your trojan load the entire ocaml runtime system
<vincenz> basically to give you an analogy
<vincenz> you're trying to fly a car
<vincenz> by building an entire plane around it
<vincenz> use a suitable langauge and you can make a smaller plane
<kingmike> ok, that's pretty clear... :-)
* vincenz loves analogies
<vincenz> i doubt the ocaml program would be more than just calling all the system methods you wrote in c
<vincenz> which kinda removes the purpose of ocaml
<kingmike> well, thanks for all those precious infos. I've only use ocaml for algorithmical purposes, I dont know nothing about other features of ocaml
<vincenz> I doubt it's suitable for system stuff, then again, you can turn any tool into a hammer, just a question how effective it'll be
<Mitar> why this works: (fun args -> Boolean (scheme_equal (List.nth args 0) (List.nth args 1))) but this does not: (fun args -> Boolean (list_for_all_trans scheme_equal args)) where list_for_all_trans is: list_for_all_trans p = function fst :: ((snd :: _) as tail) -> (p fst snd) && (list_for_all_trans p tail) | _ -> true
<vincenz> Mitar: paste on rafb.net/paste
<vincenz> it might be clearer
<vincenz> besides, the first only compares the first two elements, the second (assuming let rec) tries to compare all elements
<Mitar> yes
<Mitar> that's the point
<Mitar> it works for two
<Mitar> but it does not work for a list
<Smerdyakov> Mitar, in the first case you pass scheme_equal two arguments, and in the second you pass it only one. You can't possibly get the same type for both.
<Mitar> i do not pass only one: (p fst snd)
<Smerdyakov> Oh, ne'er mind.
<Smerdyakov> Now, how does it "not work"?
<Mitar> i get compilation error
<Mitar> it is the last line in pastebin
<kingmike> another question : operator != works with ints for "different from". Why doesn't it work for strings ?
<smimou> you should use <>
<smimou> != is physical inequality
<kingmike> what is physical inequality ?
<pango> kingmike: check if both parameters are the same (and not just identiqual)
<pango> "are they the same thing in memory"
<Smerdyakov> Mitar, I don't know what the problem is from just the code you pasted.
<kingmike> I dont see the point. two different strings are the same thing in memory ?
<Smerdyakov> kingmike, "pointer equality"
<smimou> != checks if the *pointers* are different
<Smerdyakov> Mitar, type inference can cause "errors" to be reported far away from where you would actually say the error is.
vodka-goo has quit ["Connection reset by by pear"]
<pango> kingmike: physical equality doesn't really make sense for "direct" (unboxed) values, like ints and other enumerated types
<Mitar> yes, but the difference is that once i compare just two elements
<pango> kingmike: so when you use physical equality on them, ocaml really does structural equality
<Mitar> and second time i compare all elements
<Mitar> and because first time it works
<Mitar> in must be something in this code which checks all elements
<kingmike> pango : so <> is a kind of shortcut for !=, when applied to ints ?
<kingmike> sorry, != is a shortcut for <> , obviously
<smimou> in practice yes
<pango> kingmike: yes
<kingmike> ok, thanks.
<pango> kingmike: but since it's semantically wrong, better always use structural on direct values
<pango> makes your intentions more obvious (and probably will avoid problems later ;) )
<pango> (unless you function is polymorphic and you can't know in advance, and know what you're doing...)
<pango> s/you/your/
<vincenz> list_for_all_trans should be recurisve
<Mitar> it is
<Mitar> this is all "and" between
<Mitar> and "rec" at the beginning
<vincenz> well put a full test case please
<vincenz> works fine here
<vincenz> val list_for_all_trans : ('a -> 'a -> bool) -> 'a list -> bool = <fun>
<Mitar> yes, list_for_all_trans works
<Mitar> but combination of everything does not
<Mitar> i am making a case
<vincenz> then it's probably where you're using
<vincenz> k
<vincenz> and use rafb.net/paste
<vincenz> pastebin has an issue when copying
<vincenz> it adds extra lines with #
<vincenz> so I can't paste into ocaml
<Mitar> sorry, will next time
<vincenz> no prob :)
<vincenz> just makes it easier
shirogane has quit [Remote closed the connection]
Bigb[a]ng is now known as Bigbang
<pango> kingmike: (actually why == does structural equality on direct values is quite obvious when one knows how ocaml stores values)
<pango> == just check the root word, who happens to the the tagged direct value, or the pointer to boxed value
Snark has joined #ocaml
<kingmike> I dont know nothing about how values are stored. Why do you say it is obvious ?
<pango> I just said why
<pango> it's obvious when you know the implementation
<kingmike> sorry, I had not seen your last post.
skylan has quit [Read error: 104 (Connection reset by peer)]
<pango> oh, and also 0-arity constructors are allocated once at compile time
<pango> so there's always only one instance of them in memory
<kingmike> Excuse my ignorance, but what is a 0-arity constructor ?
<pango> for example type 'a option = None | Some of 'a
<pango> None has 0-arity
<kingmike> and Some of 'a has 1-arity, constructor Foo of 'a * 'b would have 2-arity, and so on ?
skylan has joined #ocaml
<smimou> yes
<pango> yes
<kingmike> ok, understand what you wrote now
<smimou> but Foo of ('a * 'b) has 1-arity :)
<pango> # None == None ;;
<pango> - : bool = true
<pango> # Some 1 == Some 1 ;;
<pango> - : bool = false
<pango> # let some = Some 1 in some == some ;;
<pango> - : bool = true
<kingmike> ok
<kingmike> so why are == and != implemented in ocaml ?
<Smerdyakov> To allow some user-level optimizations, I'd say.
<Mitar> this is unbeliveable, this works: http://rafb.net/paste/results/cpf5pK40.html
<Mitar> but the same code in my program does not
Submarine has joined #ocaml
<Mitar> let's try newest version of ocaml
<vincenz> Mitar: what's this for?
<Mitar> maybe is this a bug
<Mitar> try the minscheme.zip
<Mitar> the same code
<Mitar> and once it works
<Mitar> the other time it does not
<Mitar> in whole program
<vincenz> not works meaning?
<vincenz> and you have way too much let rec, you don't need all that
<vincenz> only scheme_equal should be rec
<vincenz> and list_for_all_trans
Skal has quit [Remote closed the connection]
<Mitar> that it does not compiler
<Mitar> but how can i make them see each other?
<Mitar> if i do not "and" them together that they do not see each other (unbound value)
<vincenz> works fine for me
smimou has quit ["bli"]
<pango> I wonder if builtin.ml doesn't make list_for_all_trans monomorphic
<vincenz> nope
<vincenz> oh wait, cause it's a func
<vincenz> yeah
<vincenz> most likely
<vincenz> maybe the reason why it doesn't work sometiimes, once he tests on intlist
kingmike has left #ocaml []
<Mitar> hmm, but i cannot make such change (removing rec and ands in builtin.ml)
smimou has joined #ocaml
<Mitar> i changed list_for_all_trans and there is no difference
<Mitar> (and there is no difference with new version either)
<Mitar> have you tried to compile prescheme.zip/
<Mitar> ?
<Smerdyakov> Mitar, start annotating everything with explicit types until you find that something can't have the type you expect.
<Mitar> and this is done how?
<Mitar> (annotating everything with explicit type)
<Smerdyakov> let add x y = x + y
<Smerdyakov> let add (x : int) y = x + y
<Smerdyakov> let add (x : int) (y : int) : int = x + y
<Mitar> and for functions?
<Smerdyakov> That's a function.
<Mitar> if p is function/
<Mitar> let some p = p 123
<Mitar> where p is function
<Smerdyakov> Same business. Just write in the type like I showed using colons.
<Mitar> let some (p : int -> int ) = p 123
<Mitar> ?
<Smerdyakov> Sure
<Mitar> and how can i specify return value?
<ulfdoz> It returns whatever p 123 returns.
<Mitar> yes, but for debugging, that it specify what i think it should return
<Smerdyakov> Same as I just showed you.
<Mitar> so it does not compile for you too?
<Smerdyakov> I haven't tried. I have faith in the debugging methodologies that I am trying to impart. :)
<Mitar> hmm
<Mitar> they does not work
<Mitar> the problem is the same
<Mitar> strange compiler error
<Mitar> which does not tell me anything
<Smerdyakov> You annotated every argument and return value with a type?
<pango> Mitar: I think you're hitting something like http://caml.inria.fr/resources/doc/faq/core.en.html#eta-expansion
smimou has quit ["bli"]
<Mitar> pango, hmm
<Mitar> let map_id l = List.map (function x ->; x) l << what is this ; there?
<pango> a typo
<Mitar> so what is correct solution?
<Mitar> that i add an l to the parameters and remove function/
<Mitar> and add match?
<pango> mmmh maybe. I avoided running into that case so far
<Mitar> how?
smimou has joined #ocaml
<pango> by programming something else ;)
<Mitar> great
<Mitar> i allow you to try to compile my program :-)
Banana has quit ["Chantournage de disque."]
mattam has quit [Remote closed the connection]
<pango> to not define gamma and list_for_all_trans simultaneously
<Mitar> but how can i do this?
<pango> it's the let ... and ... that introduces extra type dependancies
<Mitar> so that it would be possible for gamma to access list_for_all_trans
<pango> define list_for_all_trans first and independantly
<pango> you can use anything previously defined, "and" is only necessary for cross-referencing
<Mitar> uhh, i though the order of functions does not matter
<pango> you were wrong then ;)
<Mitar> vuuaauuu
<Mitar> it works
<Mitar> thanks
<Mitar> really
<Mitar> i owe you
<Smerdyakov> Send him a flower in a shoe.
<pango> lol
<Mitar> i call a function from other file with Name.function
<Mitar> ?
<Mitar> ah, it is ok
<pango> PreScheme> (+ 1 1)
<pango> 2
<pango> ooooh :)
<Mitar> :-)
<Mitar> it works, yes
Bigbang is now known as Bigb[a]ng
* Submarine is a picture maven on wheels
lightstep has joined #ocaml
<lightstep> is there a function char list -> string?
<KrispyKringle> Probably.
<pango> not that hard to write one
<KrispyKringle> nope. gimme a sec.
<ulfdoz> Meine treue Kaffeemaschine heißt übrigens Bärbel.
<ulfdoz> ECHAN, sorry
<lightstep> i can't find function composition either in the standard library
Skal has joined #ocaml
* lightstep comes from haskell
<KrispyKringle> Is there a string_from_char or something?
<KrispyKringle> ah
<KrispyKringle> heh
<lightstep> there's String.make : int -> char -> string
<KrispyKringle> ah
<lightstep> i thought that the letter o is a function composition operator, but probably not
<KrispyKringle> lightstep: let rec foo = function
<KrispyKringle> c::cs -> (String.make 1 c) ^ (foo cs)
<KrispyKringle> | [] -> "";;
<KrispyKringle> That does it for me, though probably inefficiently.
<KrispyKringle> lightstep: Do you mean something like $ in haskell?
<lightstep> String.concat (map (String.make 1) chars)
<lightstep> no, i want (.)
<KrispyKringle> Oh.
<KrispyKringle> Heh. Good point with concat.
Snark has quit ["Leaving"]
<KrispyKringle> Beats me about a standard, lightstep. I'd say make your own.
<KrispyKringle> Ah, that's more efficient, isn't it, pango ?
<pango> should be... single string allocation, tail-rec copy...
<lightstep> pango, using a two-pass algorithm makes the poing of efficiency a bit moot
<KrispyKringle> Right.
<lightstep> s/poing/point/
<KrispyKringle> Two pass meaning List.length?
<pango> string length is immutable, so there's probably no better way
<lightstep> KrispyKringle, yes
<KrispyKringle> Still better than what you or I posted, I suspect.
<lightstep> pango, yes, unless you know the memory fragmentation of the heap
<lightstep> how do i declare infix functions?
<KrispyKringle> let (+) =
<KrispyKringle> e.g.
<pango> only function whose name is made of punctuation are infix, IIRC
<KrispyKringle> Yeah, I think you're right.
<KrispyKringle> So you have to use, say, ($), lightstep.
_JusSx_ has quit [Client Quit]
<KrispyKringle> aha. clever.
<pango> non tail-rec, however
<KrispyKringle> yeah
<lightstep> KrispyKringle, i'd prefer to override the (@) list concatenation
<KrispyKringle> lightstep: OK. Your call.
<pango> oups I forgot b after Buffer.add_char
<lightstep> how can i write get_conditionally : (a -> bool) -> a stream -> a option
<lightstep> which only takes that element if it matches the predicate?
<lightstep> pango, your buffer is limited to 10? or grows? (if it grows, it's still two-pass)
<pango> grows geometricaly
<pango> s/l/ll/
<pango> so allocation is amortized
<lightstep> yes
<lightstep> hmm, it's doable, but not with the stream syntax
<lightstep> i'm getting the hang of it. strict languages are fun
skylan has quit [Read error: 104 (Connection reset by peer)]
skylan has joined #ocaml
ellisonch has quit ["Leaving"]
Submarine has quit [Read error: 104 (Connection reset by peer)]
shirogane has joined #ocaml
smimou has quit ["bli"]
gim has joined #ocaml
lightstep has quit ["leaving"]
Skal has quit [Remote closed the connection]
Mitar has left #ocaml []
Skal has joined #ocaml
gim has quit ["zzzzz"]