Skip to content

Special constructor for %sys_argv primitive #166

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 17, 2021
Merged

Special constructor for %sys_argv primitive #166

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 7 additions & 5 deletions ocaml/lambda/translprim.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,7 @@ type loc_kind =
type prim =
| Primitive of Lambda.primitive * int
| External of Primitive.description
| Sys_argv
| Comparison of comparison * comparison_kind
| Raise of Lambda.raise_kind
| Raise_with_backtrace
Expand Down Expand Up @@ -349,7 +350,7 @@ let primitives_table =
"%bswap_native", Primitive ((Pbbswap(Pnativeint)), 1);
"%int_as_pointer", Primitive (Pint_as_pointer, 1);
"%opaque", Primitive (Popaque, 1);
"%sys_argv", External prim_sys_argv;
"%sys_argv", Sys_argv;
"%send", Send;
"%sendself", Send_self;
"%sendcache", Send_cache;
Expand Down Expand Up @@ -645,8 +646,8 @@ let lambda_of_prim prim_name prim loc args arg_exps =
match prim, args with
| Primitive (prim, arity), args when arity = List.length args ->
Lprim(prim, args, loc)
| External prim, args when prim = prim_sys_argv ->
Lprim(Pccall prim, Lconst (const_int 0) :: args, loc)
| Sys_argv, [] ->
Lprim(Pccall prim_sys_argv, [Lconst (const_int 0)], loc)
| External prim, args ->
Lprim(Pccall prim, args, loc)
| Comparison(comp, knd), ([_;_] as args) ->
Expand Down Expand Up @@ -694,7 +695,7 @@ let lambda_of_prim prim_name prim loc args arg_exps =
| Send_cache, [obj; meth; cache; pos] ->
Lsend(Cached, meth, obj, [cache; pos], loc)
| (Raise _ | Raise_with_backtrace
| Lazy_force | Loc _ | Primitive _ | Comparison _
| Lazy_force | Loc _ | Primitive _ | Sys_argv | Comparison _
| Send | Send_self | Send_cache), _ ->
raise(Error(to_location loc, Wrong_arity_builtin_primitive prim_name))

Expand All @@ -704,6 +705,7 @@ let check_primitive_arity loc p =
match prim with
| Primitive (_,arity) -> arity = p.prim_arity
| External _ -> true
| Sys_argv -> p.prim_arity = 0
| Comparison _ -> p.prim_arity = 2
| Raise _ -> p.prim_arity = 1
| Raise_with_backtrace -> p.prim_arity = 2
Expand Down Expand Up @@ -778,7 +780,7 @@ let lambda_primitive_needs_event_after = function
(* Determine if a primitive should be surrounded by an "after" debug event *)
let primitive_needs_event_after = function
| Primitive (prim,_) -> lambda_primitive_needs_event_after prim
| External _ -> true
| External _ | Sys_argv -> true
| Comparison(comp, knd) ->
lambda_primitive_needs_event_after (comparison_primitive comp knd)
| Lazy_force | Send | Send_self | Send_cache -> true
Expand Down