st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-05 22:38:44 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Better syntax syntax

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-04-11 21:09:51 +03:00
parent 7748144a8f
commit 690825f540
14 changed files with 129 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/Driver.ml
View file

@ -3,7 +3,7 @@ open Ostap
let parse cmd =
let s = Util.read cmd#get_infile in
let kws = [
"skip";
"skip";
"if"; "then"; "else"; "elif"; "fi";
"while"; "do"; "od";
"repeat"; "until";
@ -14,7 +14,7 @@ let parse cmd =
"case"; "of"; "esac"; "when";
"boxed"; "unboxed"; "string"; "sexp"; "array";
"infix"; "infixl"; "infixr"; "at"; "before"; "after";
"true"; "false"; "lazy"; "eta"]
"true"; "false"; "lazy"; "eta"; "syntax"]
in
Util.parse
(object

72
src/Language.ml
View file

@ -775,9 +775,65 @@ module Expr =
}
| %"return" e:basic[infix][Val]? => {isVoid atr} => {Return e}
| %"case" l:$ e:parse[infix][Val] %"of" bs:!(Util.listBy)[ostap ("|")][ostap (!(Pattern.parse) -"->" scope[infix][atr])] %"esac"{Case (e, bs, l#coord, atr)}
| l:$ %"lazy" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {env#add_lazy; ignore atr (Call (Var "makeLazy", [Lambda ([], e)]))}
| l:$ %"eta" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {let name = env#get_tmp in ignore atr (Lambda ([name], Call (e, [Var name])))}
| -"(" parse[infix][atr] -")"
| l:$ %"lazy" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {env#add_import "Lazy"; ignore atr (Call (Var "makeLazy", [Lambda ([], e)]))}
| l:$ %"eta" e:basic[infix][Val] => {notRef atr} :: (not_a_reference l) => {let name = env#get_tmp in ignore atr (Lambda ([name], Call (e, [Var name])))}
| l:$ %"syntax" "(" e:syntax[infix] ")" => {notRef atr} :: (not_a_reference l) => {env#add_import "Ostap"; ignore atr e}
| -"(" parse[infix][atr] -")";
syntax[infix]: ss:!(Util.listBy)[ostap ("|")][syntaxSeq infix] {
List.fold_right (fun s -> function
| Var "" -> s
| acc -> Call (Var "alt", [s; acc])
) ss (Var "")
};
syntaxSeq[infix]: ss:syntaxBinding[infix]+ sema:(-"{" parse[infix][Val] -"}")? {
let sema, ss =
match sema with
| Some s -> s, ss
| None ->
let arr, ss =
List.fold_left (fun (arr, ss) ((loc, omit, p, s) as elem) ->
match omit with
| None -> (match p with
| None -> let tmp = env#get_tmp in
((Var tmp) :: arr, (loc, omit, Some (Pattern.Named (tmp, Pattern.Wildcard)), s) :: ss)
| Some (Pattern.Named (name, _)) -> ((Var name) :: arr, elem :: ss)
| Some p -> let tmp = env#get_tmp in
((Var tmp) :: arr, (loc, omit, Some (Pattern.Named (tmp, p)), s) :: ss)
)
| Some _ -> (arr, elem :: ss)
) ([], []) ss
in
(match arr with [a] -> a | _ -> Array (List.rev arr)), List.rev ss
in
List.fold_right (fun (loc, _, p, s) ->
let make_right =
match p with
| None -> (fun body -> Lambda ([env#get_tmp], body))
| Some (Pattern.Named (name, Pattern.Wildcard)) -> (fun body -> Lambda ([name], body))
| Some p -> (fun body ->
let arg = env#get_tmp in
Lambda ([arg], Case (Var arg, [p, body], loc#coord, Val))
)
in
function
| Var "" -> Call (Var (infix_name "@"), [s; make_right sema])
| acc -> Call (Var "seq", [s; make_right acc])
) ss (Var "")
};
syntaxBinding[infix]: l:$ omit:"-"? p:(!(Pattern.parse) -"=")? s:syntaxPostfix[infix];
syntaxPostfix[infix]: s:syntaxPrimary[infix] p:("*" {`Rep0} | "+" {`Rep} | "?" {`Opt})? {
match p with
| None -> s
| Some `Opt -> Call (Var "opt" , [s])
| Some `Rep -> Call (Var "rep" , [s])
| Some `Rep0 -> Call (Var "rep0", [s])
};
syntaxPrimary[infix]: l:$ p:LIDENT args:(-"(" !(Util.list0)[parse infix Val] -")")* {
Loc.attach p l#coord;
List.fold_left (fun acc args -> Call (acc, args)) (Var p) args
}
| -"(" syntax[infix] -")"
| -"$(" parse[infix][Val] -")"
) in (fun def -> defCell := Obj.magic !def; parse),
(fun def -> defCell := Obj.magic !def; basic),
(fun def -> defCell := Obj.magic !def; scope)
@ -1147,12 +1203,12 @@ ostap (
let parse cmd =
let env =
object
val lazy_used = Pervasives.ref false
val imports = Pervasives.ref ([] : string list)
val tmp_index = Pervasives.ref 0
method add_lazy = lazy_used := true
method get_tmp = let index = !tmp_index in incr tmp_index; Printf.sprintf "__tmp%d" index
method is_lazy = !lazy_used
method add_import imp = imports := imp :: !imports
method get_tmp = let index = !tmp_index in incr tmp_index; Printf.sprintf "__tmp%d" index
method get_imports = !imports
end
in
@ -1186,7 +1242,7 @@ let parse cmd =
<(is, infix)> : imports[cmd]
<(d, infix')> : definitions[infix]
expr:expr[infix'][Expr.Weak]? {
((if env#is_lazy then "Lazy" :: is else is), Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e)
(env#get_imports @ is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e)
}
)
in

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.00, b7ec1c2e6, Mon Mar 23 00:51:00 2020 +0300"
let version = "Version 1.00, 7748144a8, Fri Apr 10 03:15:18 2020 +0300"

16
stdlib/Ostap.lama
View file

@ -74,6 +74,12 @@ public fun token (x) {
esac
}
public fun loc (k) {
fun (s) {
k $ Succ ([s.getLine, s.getCol], s)
}
}
public fun eof (k) {
fun (s) {
k (endOfMatcher (s))
@ -235,18 +241,18 @@ public fun parseString (p, s) {
acc.result
}
public fun left (f) {
public fun left (op, f) {
fun (c, x) {
fun (y) {
f (c (x), y)
f (c (x), op, y)
}
}
}
public fun right (f) {
public fun right (op, f) {
fun (c, x) {
fun (y) {
c (f (x, y))
c (f (x, op, y))
}
}
}
@ -258,7 +264,7 @@ fun altl (level) {
local assfun = case assoc of Left -> left | Right -> right | Nona -> left esac;
case map (fun (p) {
case p of
[op, sema] -> op @ lift(assfun (sema))
[op, sema] -> op @ fun (op) {assfun (op, sema)}
esac
}, ps) of
p : ps -> foldl (infix |, p, ps)

4
stdlib/regression/orig/test28.log Normal file
View file

@ -0,0 +1,4 @@
Succ (Seq ("a", "b"))
Succ (Alt ("a"))
Succ (Alt ("b"))
Succ (Rep ({"a", "a", "a"}))

4
stdlib/regression/orig/test29.log Normal file
View file

@ -0,0 +1,4 @@
Succ (Seq ("a", "b"))
Succ (Alt ("a"))
Succ (Alt ("b"))
Succ (Rep ({"a", "a", "a"}))

8
stdlib/regression/test11.lama
View file

@ -2,10 +2,10 @@ import Ostap;
import Fun;
local a = token ("a"),
add = [token ("+"), fun (l, r) {Add (l, r)}],
sub = [token ("-"), fun (l, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, r) {Mul (l, r)}],
div = [token ("/"), fun (l, r) {Div (l, r)}],
add = [token ("+"), fun (l, _, r) {Add (l, r)}],
sub = [token ("-"), fun (l, _, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, _, r) {Mul (l, r)}],
div = [token ("/"), fun (l, _, r) {Div (l, r)}],
exp = expr ({[Left, {add, sub}], [Left, {mul, div}]}, a) (id);
printf ("%s\n", parseString (exp |> bypass (eof), "a").string);

8
stdlib/regression/test12.lama
View file

@ -9,10 +9,10 @@ fun gen (depth) {
}
local a = token ("a"),
add = [token ("+"), fun (l, r) {Add (l, r)}],
sub = [token ("-"), fun (l, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, r) {Mul (l, r)}],
div = [token ("/"), fun (l, r) {Div (l, r)}],
add = [token ("+"), fun (l, _, r) {Add (l, r)}],
sub = [token ("-"), fun (l, _, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, _, r) {Mul (l, r)}],
div = [token ("/"), fun (l, _, r) {Div (l, r)}],
exp = expr ({[Left, {add, sub}], [Left, {mul, div}]}, a) (id),
i;

8
stdlib/regression/test13.lama
View file

@ -2,10 +2,10 @@ import Ostap;
import Fun;
local a = token ("a"),
add = [token ("+"), fun (l, r) {Add (l, r)}],
sub = [token ("-"), fun (l, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, r) {Mul (l, r)}],
div = [token ("/"), fun (l, r) {Div (l, r)}],
add = [token ("+"), fun (l, _, r) {Add (l, r)}],
sub = [token ("-"), fun (l, _, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, _, r) {Mul (l, r)}],
div = [token ("/"), fun (l, _, r) {Div (l, r)}],
exp = expr ({[Right, {add, sub}], [Left, {mul, div}]}, a) (id);
printf ("%s\n", parseString (exp |> bypass (eof), "a+a-a").string);

10
stdlib/regression/test14.lama
View file

@ -3,11 +3,11 @@ import Fun;
import List;
local a = token ("a"),
eq = [token ("="), fun (l, r) {Eq (l, r)}],
add = [token ("+"), fun (l, r) {Add (l, r)}],
sub = [token ("-"), fun (l, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, r) {Mul (l, r)}],
div = [token ("/"), fun (l, r) {Div (l, r)}],
eq = [token ("="), fun (l, _, r) {Eq (l, r)}],
add = [token ("+"), fun (l, _, r) {Add (l, r)}],
sub = [token ("-"), fun (l, _, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, _, r) {Mul (l, r)}],
div = [token ("/"), fun (l, _, r) {Div (l, r)}],
exp = expr ({[Nona, singleton (eq)], [Right, {add, sub}], [Left, {mul, div}]}, a) (id);
printf ("%s\n", parseString (exp |> bypass (eof), "a+a-a").string);

10
stdlib/regression/test15.lama
View file

@ -3,11 +3,11 @@ import Fun;
import List;
local a = token ("a"),
eq = [token ("="), fun (l, r) {Eq (l, r)}],
add = [token ("+"), fun (l, r) {Add (l, r)}],
sub = [token ("-"), fun (l, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, r) {Mul (l, r)}],
div = [token ("/"), fun (l, r) {Div (l, r)}],
eq = [token ("="), fun (l, _, r) {Eq (l, r)}],
add = [token ("+"), fun (l, _, r) {Add (l, r)}],
sub = [token ("-"), fun (l, _, r) {Sub (l, r)}],
mul = [token ("*"), fun (l, _, r) {Mul (l, r)}],
div = [token ("/"), fun (l, _, r) {Div (l, r)}],
exp = expr ({[Nona, singleton (eq)], [Right, {add, sub}], [Left, {mul, div}]}, a) (id);
printf ("%s\n", parseString (exp |> bypass (eof), "a=a").string);

10
stdlib/regression/test16.lama
View file

@ -3,11 +3,11 @@ import Fun;
import List;
local a = token ("a") @ lift(fun (a) {if a then "a" else "b" fi}),
eq = [token ("="), fun (l, r) {fun (a) {Eq (l (a), r (a))}}],
add = [token ("+"), fun (l, r) {fun (a) {Add (l (a), r (a))}}],
sub = [token ("-"), fun (l, r) {fun (a) {Sub (l (a), r (a))}}],
mul = [token ("*"), fun (l, r) {fun (a) {Mul (l (a), r (a))}}],
div = [token ("/"), fun (l, r) {fun (a) {Div (l (a), r (a))}}],
eq = [token ("="), fun (l, _, r) {fun (a) {Eq (l (a), r (a))}}],
add = [token ("+"), fun (l, _, r) {fun (a) {Add (l (a), r (a))}}],
sub = [token ("-"), fun (l, _, r) {fun (a) {Sub (l (a), r (a))}}],
mul = [token ("*"), fun (l, _, r) {fun (a) {Mul (l (a), r (a))}}],
div = [token ("/"), fun (l, _, r) {fun (a) {Div (l (a), r (a))}}],
exp = expr ({[Nona, singleton (eq)], [Right, {add, sub}], [Left, {mul, div}]}, a) (id);
fun unpack (x, y) {

8
stdlib/regression/test28.lama Normal file
View file

@ -0,0 +1,8 @@
local sq = syntax (e1=token ("a") e2=token ("b") {Seq (e1, e2)}),
al = syntax (e=(token ("a") | token ("b")) {Alt (e)}),
rp = syntax (e=token ("a")* {Rep (e)});
printf ("%s\n", parseString (syntax (p=sq eof {p}), "ab").string);
printf ("%s\n", parseString (syntax (p=al eof {p}), "a").string);
printf ("%s\n", parseString (syntax (p=al eof {p}), "b").string);
printf ("%s\n", parseString (syntax (p=rp eof {p}), "aaa").string)

8
stdlib/regression/test29.lama Normal file
View file

@ -0,0 +1,8 @@
local sq = syntax (e1=token ("a") e2=token ("b") {Seq (e1, e2)}),
al = syntax (e=(token ("a") | token ("b")) {Alt (e)}),
rp = syntax (e=token ("a")* {Rep (e)});
printf ("%s\n", parseString (syntax (sq -eof), "ab").string);
printf ("%s\n", parseString (syntax (al -eof), "a").string);
printf ("%s\n", parseString (syntax (al -eof), "b").string);
printf ("%s\n", parseString (syntax (rp -eof), "aaa").string)