kjs3 has quit [Read error: 110 (Connection timed out)]
tav has quit [Read error: 104 (Connection reset by peer)]
tav|away has joined #ocaml
johs has joined #ocaml
Yurik has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
Demitar has joined #ocaml
Demitar has quit []
jx_ has quit [Remote closed the connection]
Demitar has joined #ocaml
<Demitar>
How do I append a char to a string?
<physarum>
Char.escaped
<physarum>
Char.escaped : char -> string
<Demitar>
Thanks.
<Demitar>
Hmm... is there no other way to iterate over a string than calling get repeatedly?
TimFreeman has joined #ocaml
<TimFreeman>
Is anyone here awake? I'm looking for documentation for the "parser" keyword (or is it a function?) I see in the ocaml examples in the ocaml debian package. The examples don't compile.
<emu>
what are "extensible datatypes" in ML? (as opposed to 'fixed' datatypes)
<smkl>
ML only has one extensible datatype, the type of exceptions
<emu>
could they be used to simulate dynamic type-checking of any type?
<emu>
this is the example that was given:
<emu>
datatype tagged = Int of int | Bool of bool | Fun of tagged -> tagged
<emu>
exception TypeError
<emu>
fun checked add (m:tagged, n:tagged):tagged = case (m,n) of (Int a, Int b) => Int (a+b) | ( , ) => raise TypeError
<emu>
that should be (_, _)
<emu>
but I can show that to be incorrect
<emu>
so the prof's counterargument was an 'extensible datatype' could achieve 'extensible tagging'
<emu>
so that I could 'extend' the datatype 'tagged' without recompiling the function 'checked_add'
<smkl>
you could use the type of exceptions instead of "tagged". also it's possible to add case "Ext of 'ext" ... then it can be extended but that is a bit cumbersome
TimFreeman has left #ocaml []
TimFreeman has joined #ocaml
<TimFreeman>
Does anyone have the URL for logs of this channel? It used to be in the channel topic, but no more.
<Demitar>
Hmm... now I'm getting a bit confused... context follows ->
<Demitar>
File "codec_packed.ml", line 20, characters 33-55:
<Demitar>
This expression has type 'a list but is here used with type
<Demitar>
Object.atlasobject
<Demitar>
line 19-20:
<Demitar>
(match current with
<Demitar>
[] -> current <- [(namebuffer, obj) :: m]
<Demitar>
other useful info:
<Demitar>
val mutable current : atlasobject list = []
<Demitar>
type atlasobject = Map of (string * atlasobject) list | List of atlasobject list | String of string | Int of int | Float of float;;
<Demitar>
m is a Map and namebuffer a string and obj should be an atlasobject I hope...
<Demitar>
it is, (added a type constraint)
<smkl>
emu: nope ... it's a conditional like if-then-else ... it can be used to simulate run-time typechecks though
<TimFreeman>
emu: Case really does get errors at runtime if none of the cases apply, so in some sense it is a run time typecheck. Depends on exactly what you mean by "type".
<emu>
well he is arguing that a 'tagged' type of some sort can be used to simulate runtime typechecking
<smkl>
err
<emu>
in combination with 'case'
<smkl>
Demitar: [Map ((namebuffer, obj) :: m)]
<emu>
whereas my argument is that this doesn't permit runtime modification of the type, nor can you call the function with any old type that you feel like
<Demitar>
Whee, that helped now I just need to trace down those matching failures.
<TimFreeman>
emu: Depends on what you mean by type. If type only distinguishes things of type tagged from things not of type tagged, then your argument is right. If type also distinguishes the Int, Bool, and Fun cases of tagged from ...
<TimFreeman>
each other, then the add function is really doing run-time type checking.
<TimFreeman>
In ocaml, "type" is used with the former meaning.
<emu>
ok maybe i should be more clear; dynamic type-checking also entails extensibility
<Demitar>
What do those Match_failure numbers mean? *goes to read the manual*
<emu>
as well as runtime type-checking
<smkl>
the concept of types at runtime is problematic, anyway
<TimFreeman>
emu: Not sure I agree with your definition of dynamic type-checking. For instance, lisp does dynamic type-checking, and it doesn't let me make radically new kinds of objects that are different from anything it knew about ...
<TimFreeman>
before. (Here I'm claiming the results from "defstruct" aren't radical.)
<smkl>
Demitar: probably character numbers of the source file
<TimFreeman>
You could encode lisp's defstruct as one more case in your "tagged" type.
<smkl>
Demitar: the compiler should warn in every case it's possible that a match fails
<emu>
you mean structure-classes?
<emu>
that's the metaclass anyho
<TimFreeman>
emu: I suppose so. Whatever sort of user-declared types lisp admits nowadays.
<emu>
deftype, defclass
<TimFreeman>
Oh well, gotta get to work. Bye all.
TimFreeman has quit ["ircII/tkirc"]
<emu>
both of which create derived types
<smkl>
obviously a dynamic type system can be simulated. what cannot be done that easily is to have run-time checking for the actual types
<Demitar>
smkl: Yes it's the character start and stop and I intentionally don't match everything since those things should be impossible if correct data is fed. (will fill some exceptions later)
<emu>
smkl: I'm not sure I understand how your two statements are compatible
<emu>
or by 'actual types' you mean the predefined ones... int, string, char...
<emu>
?
<smkl>
emu: i mean ML types
<smkl>
as Tim said, the dynamic type system can be easily extended ... but it cannot be extended with new ML types
<emu>
I understand a 'type' to be a set of objects
<emu>
what do you mean by "ML type"?
<smkl>
by ML type, i obviously mean a type defined in ML, for example datatype contruct defines a new ML type (or type constructor)
<emu>
ok
<emu>
what can it be extended with?
<emu>
(and are we talking about a dynamic system that uses exceptions or that 'tagged' datatype from before?)
<smkl>
it doesn't matter which one
<smkl>
i mean which mechanism, the tagged one would just need new tags for the user-defieable types
<emu>
the exception mechanism seems to be able to handle new user-defined types
<smkl>
say you want to have type of enumerations, then you can have tag Enum of (string list * int) ... then user can construct stuff like: let bool = ["T";"F"] let true = Enum (bool, 1) etc. this way is of course cumbersome, some kind of mutable structures can be used to store the "types"
<emu>
essentially you begin to implement a 'dynamic type system' on top of the ML type system
<smkl>
yes .. that is the way to simulate dynamic type systems. with exceptions, it can be done a bit better
<emu>
since exceptions have dynamic semantics
<emu>
but would this constitute a proof that 'dynamic type-checking' is a special-case of 'static type-checking'?
<smkl>
no, because dynamic type-checking is a run-time operation and static is something else. dynamically typed languages are a special case of statically typed languages though, they have only one static type
<emu>
you realize that one can look at it the other way too: statically typed languages are the special-case of dynamically typed languages that elide every runtime type-check
<smkl>
nope, you can have a statically typed language that includes "typecase" construct
<emu>
I didn't say that well
<emu>
I don't view it as two possibilities
<emu>
but a continuum
<emu>
(no typechecks elided) <------------------------> (all typechecks elided)
<Demitar>
Are ocaml lists single linked? (ie should I :: my items and then reverse the whole thing?)
<emu>
Demitar: think of the underlying representation.. the cons
<Demitar>
Eh? (the thing is kind of that I get my items in the correct order and order happends to be important here)
<emu>
conses have two places.
<emu>
one of them goes to the data. the other to the rest of the list
<Demitar>
So I can do it either way?
<Demitar>
data :: list *or* list :: data ?
<emu>
if you append, you have to traverse the list each time to append a new element
<emu>
no
<emu>
not in ML anyway
<emu>
'a and 'a list are the two spots
<Demitar>
Well that was what I assumed.
<emu>
well your question was 'are ocaml lists singly linked?'
<Demitar>
And thus it'll be faster to simply add them up front and reverse the whole thing.
<emu>
or destructively append
<Demitar>
destructively append?
<smkl>
the lists datatype could be defined as "type 'a list = Nil | Cons of 'a * 'a list"
<smkl>
in the default lists are functional, they cannot be destroyed
<Demitar>
Hmm... guess I could abuse @ *snicker*
<emu>
smkl: so a statically typed language that permitted runtime typechecks would fall somewhere on that continuum close to the right side
<smkl>
anyway, if you want to append, you need to find the end of the list so it would become O(n^2)
<Demitar>
Well now I have a working implementation (abusing @) performance will have to wait until another day.
<emu>
nothing wrong with consing and reversing
<smkl>
emu: who is your prof?
<Demitar>
Only that it'd make my change a bit less isolated and thus it'll have to wait.
<emu>
he's not currently my prof but is author of the book that prompted this discussion: robert harper
<smkl>
that was my guess ...
owll has joined #ocaml
<smkl>
simulating a dynamic type system is not very interesting, because dynamic types are needed rarely. but with more powerful type systems, it's possible to implement a static type system and then work with those types like they were data: http://www.dur.ac.uk/~dcs1ctm/generic/
<emu>
simulating one may not be interesting but using one is
Yurik has joined #ocaml
<Demitar>
Hmm... how do I access what I match with _ ?
<Demitar>
ah, figured
Yurik has quit [Remote closed the connection]
Yurik has joined #ocaml
Yurik has quit [Remote closed the connection]
Yurik has joined #ocaml
<Demitar>
Any nice docs on embedding ocaml? (In an ocaml application as a scripting language.)
<smkl>
that is a bit tricky
<Demitar>
Would I be better off doing something else?
<smkl>
the best is just to have no scripting before it is really needed. if it is needed, there are dynamic loading and toplevel modules, but they only work for bytecode, so you need to use the asmdynlink library
<Demitar>
Well I wouldn't actually need all the power but some kind of console would be needed but if would also be extremely useful to be able to test out stuff before sending code to the server (looking into making an ocaml rim for stage).
<Demitar>
It would of course be preferred if it could be sanboxed and given access to various application interfaces.
<smkl>
it is possible to run your program with the toploop, in another thread
<smkl>
i think that the best way to implement sandboxing is to restrict the standard library, like it was done in mmm. that is a bit complex, though
<Demitar>
I'd like on-the-fly evaluation of expressions of course...
<smkl>
hmm, actually the dynlink module seems to have some features for sand-boxing, see it's documentation
<Demitar>
Yes I saw that but it only seems to be able to load precompiled bytecode which is something I wouldn't have.
<Demitar>
A bytecode compiler and interpreter is what I'd want I guess.
<smkl>
toplevel library does that, but it doesn't work with native code, so you'd have to use asmdynlink
<Demitar>
Where can I find it? No match in the index nor the caml hump.
<smkl>
toplevellib.cma ... see caml sources in toplevel/ for "documentation"
<Demitar>
Ah, use the source... :)
<Demitar>
Then I need to get the source of course...
<smkl>
i don't know if there is any good way to implement sandboxing in the toplevel
<Demitar>
Well I'll simply have to investigate...
<smkl>
one thing that can perhaps be used is the toplevel_env variable
<Demitar>
Thanks, later.
Demitar has quit []
owll has quit ["Client Exiting"]
Yurik has quit ["Client Exiting"]
tav|away is now known as tav
tav has quit [Read error: 104 (Connection reset by peer)]
tav has joined #ocaml
johs has quit [carter.openprojects.net irc.openprojects.net]