st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-08 07:48: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 *)
ostap (
parse:
!(Ostap.Util.expr
(fun x -> x)
(Array.map (fun (a, s) ->
!(Ostap.Util.expr)
[fun x -> x]
[Array.map (fun (a, s) ->
a,
List.map (fun s -> ostap(- $(s)), (fun x y -> Sexp ("cons", [x; y]))) s)
[|`Righta, [":"]|]
)
primary);
]
[primary];
primary:
%"_" {Wildcard}
| 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 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 =
Array.map
(fun (assoc, (atrs, list)) ->
@ -624,7 +624,7 @@ module Expr =
)]
)
in
ostap (inner[0][id][atr])
ostap (inner[0][id][atr]))))
let atr' = atr
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];
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]:
s:(s:"-"? {match s with None -> fun x -> x | _ -> fun x -> Binop ("-", Const 0, x)})
@ -646,7 +646,7 @@ module Expr =
| "." %"length" {`Len}
| "." %"string" {`Str}
| "[" 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
| `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)
)
}
| 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))}
| 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] -"}"
| 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
| _ -> 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))}
| %"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)}
| -"(" parse[def][infix][atr] -")"
)
@ -749,8 +749,8 @@ module Expr =
| c:CHAR {Const (Char.code c)}
| %"true" {Const 1}
| %"false" {Const 0}
| "[" 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]) "]" {Array es}
| "{" 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)}
| l:$ x:LIDENT {Loc.attach x l#coord; Var x}
| -"(" constexpr -")"
@ -931,7 +931,7 @@ module Definition =
Loc.attach name l#coord;
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 *)
local_var[m][infix][expr][def]: l:$ name:LIDENT value:(-"=" expr[def][infix][Expr.Val])? {
Loc.attach name l#coord;
@ -941,8 +941,8 @@ module Definition =
};
parse[infix][expr][expr'][def]:
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}
| - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:!(Util.list0 arg) -")"
locs:(!(Util.list)[local_var m infix expr' def]) ";" {locs, infix}
| - <(m, orig_name, name, infix', flag)> : head[infix] -"(" -args:(!(Util.list0)[arg]) -")"
(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";
match m with
@ -1047,7 +1047,7 @@ let eval (_, expr) i =
(* Top-level parser *)
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 infix =
List.fold_left