<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
<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
<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 ;) )