diff --git a/regression/x86only/orig/test006.log b/regression/x86only/orig/test006.log new file mode 100644 index 000000000..dd333ad49 --- /dev/null +++ b/regression/x86only/orig/test006.log @@ -0,0 +1,3 @@ +3 +{1} +{1} diff --git a/regression/x86only/test006.expr b/regression/x86only/test006.expr new file mode 100644 index 000000000..178768ed0 --- /dev/null +++ b/regression/x86only/test006.expr @@ -0,0 +1,3 @@ +printf ("%d\n", infix + (1, 2)); +printf ("%s\n", (1 : 2).string); +printf ("%s\n", (infix : (1, 2)).string) diff --git a/runtime/Std.i b/runtime/Std.i index a4f4941f8..665d834fe 100644 --- a/runtime/Std.i +++ b/runtime/Std.i @@ -21,5 +21,19 @@ F,read; F,write; F,compare; F,i__Infix_4343; +F,s__Infix_58; +F,s__Infix_3333; +F,s__Infix_3838; +F,s__Infix_6161; +F,s__Infix_3361; +F,s__Infix_6061; +F,s__Infix_60; +F,s__Infix_6261; +F,s__Infix_62; +F,s__Infix_43; +F,s__Infix_45; +F,s__Infix_42; +F,s__Infix_47; +F,s__Infix_37; L,"++",T,"+"; diff --git a/runtime/runtime.c b/runtime/runtime.c index 2443a92e7..f7987449c 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -93,6 +93,124 @@ typedef struct { } sexp; extern void* alloc (size_t); +extern void* Bsexp (int n, ...); + +// Functional synonym for built-in operator ":"; +void* Ls__Infix_58 (void *p, void *q) { + void *res; + + __pre_gc (); + + res = Bsexp (3, p, q, 848787); + + __post_gc (); + + return res; +} + +// Functional synonym for built-in operator "!!"; +int Ls__Infix_3333 (void *p, void *q) { + ASSERT_UNBOXED("captured !!:1", p); + ASSERT_UNBOXED("captured !!:2", q); + + return BOX(UNBOX(p) || UNBOX(q)); +} + +// Functional synonym for built-in operator "&&"; +int Ls__Infix_3838 (void *p, void *q) { + ASSERT_UNBOXED("captured &&:1", p); + ASSERT_UNBOXED("captured &&:2", q); + + return BOX(UNBOX(p) && UNBOX(q)); +} + +// Functional synonym for built-in operator "=="; +int Ls__Infix_6161 (void *p, void *q) { + ASSERT_UNBOXED("captured ==:1", p); + ASSERT_UNBOXED("captured ==:2", q); + + return BOX(UNBOX(p) == UNBOX(q)); +} + +// Functional synonym for built-in operator "!="; +int Ls__Infix_3361 (void *p, void *q) { + ASSERT_UNBOXED("captured !=:1", p); + ASSERT_UNBOXED("captured !=:2", q); + + return BOX(UNBOX(p) != UNBOX(q)); +} + +// Functional synonym for built-in operator "<="; +int Ls__Infix_6061 (void *p, void *q) { + ASSERT_UNBOXED("captured <=:1", p); + ASSERT_UNBOXED("captured <=:2", q); + + return BOX(UNBOX(p) <= UNBOX(q)); +} + +// Functional synonym for built-in operator "<"; +int Ls__Infix_60 (void *p, void *q) { + ASSERT_UNBOXED("captured <:1", p); + ASSERT_UNBOXED("captured <:2", q); + + return BOX(UNBOX(p) < UNBOX(q)); +} + +// Functional synonym for built-in operator ">="; +int Ls__Infix_6261 (void *p, void *q) { + ASSERT_UNBOXED("captured >=:1", p); + ASSERT_UNBOXED("captured >=:2", q); + + return BOX(UNBOX(p) >= UNBOX(q)); +} + +// Functional synonym for built-in operator ">"; +int Ls__Infix_62 (void *p, void *q) { + ASSERT_UNBOXED("captured >:1", p); + ASSERT_UNBOXED("captured >:2", q); + + return BOX(UNBOX(p) > UNBOX(q)); +} + +// Functional synonym for built-in operator "+"; +int Ls__Infix_43 (void *p, void *q) { + ASSERT_UNBOXED("captured +:1", p); + ASSERT_UNBOXED("captured +:2", q); + + return BOX(UNBOX(p) + UNBOX(q)); +} + +// Functional synonym for built-in operator "-"; +int Ls__Infix_45 (void *p, void *q) { + ASSERT_UNBOXED("captured -:1", p); + ASSERT_UNBOXED("captured -:2", q); + + return BOX(UNBOX(p) - UNBOX(q)); +} + +// Functional synonym for built-in operator "*"; +int Ls__Infix_42 (void *p, void *q) { + ASSERT_UNBOXED("captured *:1", p); + ASSERT_UNBOXED("captured *:2", q); + + return BOX(UNBOX(p) * UNBOX(q)); +} + +// Functional synonym for built-in operator "/"; +int Ls__Infix_47 (void *p, void *q) { + ASSERT_UNBOXED("captured /:1", p); + ASSERT_UNBOXED("captured /:2", q); + + return BOX(UNBOX(p) / UNBOX(q)); +} + +// Functional synonym for built-in operator "%"; +int Ls__Infix_37 (void *p, void *q) { + ASSERT_UNBOXED("captured %:1", p); + ASSERT_UNBOXED("captured %:2", q); + + return BOX(UNBOX(p) % UNBOX(q)); +} extern int Blength (void *p) { data *a = (data*) BOX (NULL); diff --git a/src/Driver.ml b/src/Driver.ml index 601dc49f1..fd0a3e59f 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -110,7 +110,7 @@ class options args = end let main = - try + (* try *) let cmd = new options Sys.argv in match (try parse cmd with Language.Semantic_error msg -> `Fail msg) with | `Ok prog -> @@ -137,5 +137,5 @@ let main = List.iter (fun i -> Printf.printf "%d\n" i) output ) | `Fail er -> Printf.eprintf "Error: %s\n" er - with Language.Semantic_error msg -> Printf.printf "Error: %s\n" msg +(*with Language.Semantic_error msg -> Printf.printf "Error: %s\n" msg *) diff --git a/src/Language.ml b/src/Language.ml index 474fc1831..ad14502ec 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -180,12 +180,7 @@ module State = (* Undefined state *) let undefined x = -(* let ops = - List.map (fun op -> infix_name op, op) - - in - try Value.Var (Value.Fun (List.assoc x ops)) with - Not_found -> *) report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" x) + report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" x) (* Create a state from bindings list *) let from_list l = fun x -> try List.assoc x l with Not_found -> report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" x) @@ -617,6 +612,9 @@ module Expr = let atr' = atr let not_a_reference s = new Reason.t (Msg.make "not a reference" [||] (Msg.Locator.Point s#coord)) + + (* UGLY! *) + let predefined_op : (Obj.t -> Obj.t -> Obj.t) ref = Pervasives.ref (fun _ _ -> invalid_arg "must not happen") (* ======= *) ostap ( @@ -681,7 +679,18 @@ module Expr = | l:$ c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} :: (not_a_reference l) => {ignore atr c} - | l:$ %"infix" s:INFIX => {notRef atr} :: (not_a_reference l) => {let name = infix_name s in Loc.attach name l#coord; ignore atr (Var name)} + | l:$ %"infix" s:INFIX => {notRef atr} :: (not_a_reference l) => { + if ((* UGLY! *) Obj.magic !predefined_op) infix s + then ( + if s = ":=" + then report_error ~loc:(Some l#coord) (Printf.sprintf "can not capture predefined operator \":=\"") + else + let name = sys_infix_name s in Loc.attach name l#coord; ignore atr (Var name) + ) + else ( + let name = infix_name s in Loc.attach name l#coord; ignore atr (Var name) + ) + } | l:$ %"fun" "(" args:!(Util.list0)[ostap (l:$ x:LIDENT {Loc.attach x l#coord; x})] ")" "{" body:scope[def][infix][Weak][parse def] "}"=> {notRef atr} :: (not_a_reference l) => {ignore atr (Lambda (args, body))} | l:$ "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} :: (not_a_reference l) => {ignore atr (Array es)} @@ -722,10 +731,10 @@ module Expr = module Infix = struct - @type kind = Predefined | Public | Local with show - @type ass = [`Lefta | `Righta | `Nona] with show - @type loc = [`Before of string | `After of string | `At of string] with show - @type export = (ass * string * loc) list with show + @type kind = Predefined | Public | Local with show + @type ass = [`Lefta | `Righta | `Nona] with show + @type loc = [`Before of string | `After of string | `At of string] with show + @type export = (ass * string * loc) list with show @type showable = (ass * string * kind) list array with show type t = ([`Lefta | `Righta | `Nona] * ((Expr.atr -> (Expr.atr * Expr.atr)) * ((string * kind * (Expr.t -> Expr.atr -> Expr.t -> Expr.t)) list))) array @@ -765,6 +774,19 @@ module Infix = let is_predefined op = List.exists (fun x -> op = x) [":"; "!!"; "&&"; "=="; "!="; "<="; "<"; ">="; ">"; "+"; "-"; "*" ; "/"; "%"; ":="] + (* + List.iter (fun op -> + Printf.eprintf "F,%s\n" (sys_infix_name op); + (* + Printf.eprintf "// Functional synonym for built-in operator \"%s\";\n" op; + Printf.eprintf "int L%s (void *p, void *q) {\n" (sys_infix_name op); + Printf.eprintf " ASSERT_UNBOXED(\"captured %s:1\", p);\n" op; + Printf.eprintf " ASSERT_UNBOXED(\"captured %s:2\", q);\n\n" op; + Printf.eprintf " return BOX(UNBOX(p) %s UNBOX(q));\n" op; + Printf.eprintf "}\n\n" *) + ) [":"; "!!"; "&&"; "=="; "!="; "<="; "<"; ">="; ">"; "+"; "-"; "*" ; "/"; "%"] + *) + let default : t = Array.map (fun (a, s) -> a, @@ -782,13 +804,23 @@ module Infix = |] exception Break of [`Ok of t | `Fail of string] - + let find_op infix op cb ce = try Array.iteri (fun i (_, (_, l)) -> if List.exists (fun (s, _, _) -> s = op) l then raise (Break (cb i))) infix; ce () with Break x -> x + let predefined_op infix op = + Array.exists + (fun (_, (_, l)) -> + List.exists (fun (s, p, _) -> s = op && p = Predefined) l + ) + infix;; + + (* UGLY!!! *) + Expr.predefined_op := (Obj.magic) predefined_op;; + let no_op op coord = `Fail (Printf.sprintf "infix \"%s\" not found in the scope" op) let kind_of = function true -> Public | _ -> Local diff --git a/src/SM.ml b/src/SM.ml index dbb157396..075f9be96 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -271,8 +271,6 @@ let check_name_and_add names name mut = | Top of fundef list | Item of fundef * fundef list * context with show - -(* @type funinfo = {parent : string; closure : Value.designation list} with show *) let init_scope st = { st = st;