st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-08 15:58:47 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Language.ml new memoization errors fixed

Browse source
This commit is contained in:
kverty 2020-01-27 03:39:55 +03:00
parent d93995c444
commit 8f00033fa9
1 changed files with 89 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

38
src/Language.ml
View file

@ -299,14 +299,14 @@ module Pattern =
(* Pattern parser *) (* Pattern parser *)
ostap ( ostap (
parse: parse:
!(Ostap.Util.expr !(Ostap.Util.expr)
(fun x -> x) [fun x -> x]
(Array.map (fun (a, s) -> [Array.map (fun (a, s) ->
a, a,
List.map (fun s -> ostap(- $(s)), (fun x y -> Sexp ("cons", [x; y]))) s) List.map (fun s -> ostap(- $(s)), (fun x y -> Sexp ("cons", [x; y]))) s)
[|`Righta, [":"]|] [|`Righta, [":"]|]
) ]
primary); [primary];
primary: primary:
%"_" {Wildcard} %"_" {Wildcard}
| t:UIDENT ps:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match ps with None -> [] | Some ps -> ps)} | t:UIDENT ps:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match ps with None -> [] | Some ps -> ps)}
@ -599,7 +599,7 @@ module Expr =
let left f c x a y = f (c x) a y let left f c x a y = f (c x) a y
let right f c x a y = c (f x a y) let right f c x a y = c (f x a y)
let expr f ops opnd atr = let expr = Mem.memoize (fun f -> Mem.memoize (fun ops -> Mem.memoize (fun opnd ->
let ops = let ops =
Array.map Array.map
(fun (assoc, (atrs, list)) -> (fun (assoc, (atrs, list)) ->
@ -624,7 +624,7 @@ module Expr =
)] )]
) )
in in
ostap (inner[0][id][atr]) ostap (inner[0][id][atr]))))
let atr' = atr let atr' = atr
let not_a_reference s = new Reason.t (Msg.make "not a reference" [||] (Msg.Locator.Point s#coord)) let not_a_reference s = new Reason.t (Msg.make "not a reference" [||] (Msg.Locator.Point s#coord))
@ -638,7 +638,7 @@ module Expr =
| basic[def][infix][atr]; | basic[def][infix][atr];
scope[def][infix][atr][e]: <(d, infix')> : def[infix] expr:e[infix'][atr] {Scope (d, expr)}; scope[def][infix][atr][e]: <(d, infix')> : def[infix] expr:e[infix'][atr] {Scope (d, expr)};
basic[def][infix][atr]: !(expr (fun x -> x) (Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, _, f) -> ostap (- $(s)), f) l)) infix) (primary def infix) atr); basic[def][infix][atr]: !(expr)[fun x -> x][Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, _, f) -> ostap (- $(s)), f) l)) infix][primary def infix][atr];
primary[def][infix][atr]: primary[def][infix][atr]:
s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)}) s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)})
@ -646,7 +646,7 @@ module Expr =
| "." %"length" {`Len} | "." %"length" {`Len}
| "." %"string" {`Str} | "." %"string" {`Str}
| "[" i:parse[def][infix][Val] "]" {`Elem i} | "[" i:parse[def][infix][Val] "]" {`Elem i}
| "(" args:!(Util.list0)[parse def infix Val] ")" {`Call args} | "(" args:(!(Util.list0)[parse def infix Val]) ")" {`Call args}
)+ )+
=> {match (List.hd (List.rev is)), atr with => {match (List.hd (List.rev is)), atr with
| `Elem i, Reff -> true | `Elem i, Reff -> true
@ -707,11 +707,11 @@ module Expr =
let name = infix_name s in Loc.attach name l#coord; ignore atr (Var name) 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})] ")" | 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))} "{" 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)} | l:$ "[" es:(!(Util.list0)[parse def infix Val]) "]" => {notRef atr} :: (not_a_reference l) => {ignore atr (Array es)}
| -"{" scope[def][infix][atr][parse def] -"}" | -"{" scope[def][infix][atr][parse def] -"}"
| l:$ "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} :: (not_a_reference l) => {ignore atr (match es with | l:$ "{" es:(!(Util.list0)[parse def infix Val]) "}" => {notRef atr} :: (not_a_reference l) => {ignore atr (match es with
| [] -> Const 0 | [] -> Const 0
| _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0)) | _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0))
} }
@ -736,7 +736,7 @@ module Expr =
| %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {materialize atr (Repeat (s, e))} | %"repeat" s:scope[def][infix][Void][parse def] %"until" e:basic[def][infix][Val] => {isVoid atr} => {materialize atr (Repeat (s, e))}
| %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e} | %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e}
| %"case" l:$ e:parse[def][infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[def][infix][atr][parse def])] %"esac" | %"case" l:$ e:parse[def][infix][Val] %"of" bs:(!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[def][infix][atr][parse def])]) %"esac"
{Case (e, bs, l#coord, atr)} {Case (e, bs, l#coord, atr)}
| -"(" parse[def][infix][atr] -")" | -"(" parse[def][infix][atr] -")"
) )
@ -749,8 +749,8 @@ module Expr =
| c:CHAR {Const (Char.code c)} | c:CHAR {Const (Char.code c)}
| %"true" {Const 1} | %"true" {Const 1}
| %"false" {Const 0} | %"false" {Const 0}
| "[" es:!(Util.list0)[constexpr] "]" {Array es} | "[" es:(!(Util.list0)[constexpr]) "]" {Array es}
| "{" es:!(Util.list0)[constexpr] "}" {match es with [] -> Const 0 | _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0)} | "{" es:(!(Util.list0)[constexpr]) "}" {match es with [] -> Const 0 | _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0)}
| t:UIDENT args:(-"(" !(Util.list)[constexpr] -")")? {Sexp (t, match args with None -> [] | Some args -> args)} | t:UIDENT args:(-"(" !(Util.list)[constexpr] -")")? {Sexp (t, match args with None -> [] | Some args -> args)}
| l:$ x:LIDENT {Loc.attach x l#coord; Var x} | l:$ x:LIDENT {Loc.attach x l#coord; Var x}
| -"(" constexpr -")" | -"(" constexpr -")"
@ -931,7 +931,7 @@ module Definition =
Loc.attach name l#coord; Loc.attach name l#coord;
name, (`Public, `Variable (Some value)) name, (`Public, `Variable (Some value))
}; };
constdef: %"public" d:!(Util.list (const_var)) ";" {d}; constdef: %"public" d:(!(Util.list)[const_var]) ";" {d};
(* end of the workaround *) (* end of the workaround *)
local_var[m][infix][expr][def]: l:$ name:LIDENT value:(-"=" expr[def][infix][Expr.Val])? { local_var[m][infix][expr][def]: l:$ name:LIDENT value:(-"=" expr[def][infix][Expr.Val])? {
Loc.attach name l#coord; Loc.attach name l#coord;
@ -941,8 +941,8 @@ module Definition =
}; };
parse[infix][expr][expr'][def]: parse[infix][expr][expr'][def]:
m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern}) m:(%"local" {`Local} | %"public" e:(%"external")? {match e with None -> `Public | Some _ -> `PublicExtern} | %"external" {`Extern})
locs:!(Util.list (local_var m infix expr' def)) ";" {locs, infix} locs:(!(Util.list)[local_var m infix expr' def]) ";" {locs, infix}
| - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:!(Util.list0 arg) -")" | - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:(!(Util.list0)[arg]) -")"
(l:$ "{" body:expr[def][infix'][Expr.Weak] "}" { (l:$ "{" body:expr[def][infix'][Expr.Weak] "}" {
if flag && List.length args != 2 then report_error ~loc:(Some l#coord) "infix operator should accept two arguments"; if flag && List.length args != 2 then report_error ~loc:(Some l#coord) "infix operator should accept two arguments";
match m with match m with
@ -1047,7 +1047,7 @@ let eval (_, expr) i =
(* Top-level parser *) (* Top-level parser *)
ostap ( ostap (
imports[cmd]: l:$ is:(%"import" !(Util.list (ostap (UIDENT))) -";")* { imports[cmd]: l:$ is:(%"import" !(Util.list)[ostap (UIDENT)]) -";")* {
let is = "Std" :: List.flatten is in let is = "Std" :: List.flatten is in
let infix = let infix =
List.fold_left List.fold_left