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

Synched with ostap

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-12-31 00:59:28 +03:00
parent 49250b0216
commit cf2b696803
5 changed files with 92 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

1
runtime/Std.i
View file

@ -4,6 +4,7 @@ F,hd;
F,tl;
F,readLine;
F,stringcat;
F,matchSubString;
F,sprintf;
F,makeString;
F,printf;

7
runtime/runtime.c
View file

@ -288,6 +288,13 @@ static void stringcat (void *p) {
}
}
extern int LmatchSubString (char *subj, char *patt, int pos) {
data *p = TO_DATA(patt);
int n = LEN (p->tag);
return BOX(strncmp (subj + UNBOX(pos), patt, n) == 0);
}
extern int Lcompare (void *p, void *q) {
# define COMPARE_AND_RETURN(x,y) do if (x != y) return BOX(x - y); while (0)
if (UNBOXED(p)) {

20
src/Language.ml
View file

@ -11,8 +11,6 @@ open Combinators
exception Semantic_error of string
let unquote s = String.sub s 1 (String.length s - 2)
module Loc =
struct
@type t = int * int with show, html
@ -279,7 +277,7 @@ module Pattern =
}
| x:LIDENT y:(-"@" parse)? {match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)}
| s:("-")? c:DECIMAL {Const (match s with None -> c | _ -> ~-c)}
| s:STRING {String (unquote s)}
| s:STRING {String s}
| c:CHAR {Const (Char.code c)}
| %"true" {Const 1}
| %"false" {Const 0}
@ -689,12 +687,12 @@ module Expr =
| base[def][infix][atr];
base[def][infix][atr]:
n:DECIMAL => {notRef atr} => {ignore atr (Const n)}
| s:STRING => {notRef atr} => {ignore atr (String (unquote s))}
| s:STRING => {notRef atr} => {ignore atr (String s)}
| c:CHAR => {notRef atr} => {ignore atr (Const (Char.code c))}
| c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} => {ignore atr c}
| %"infix" s:STRING => {notRef atr} => {ignore atr (Var (infix_name @@ unquote s))}
| %"infix" s:STRING => {notRef atr} => {ignore atr (Var (infix_name s))}
| %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" body:basic[def][infix][Void] => {notRef atr} => {ignore atr (Lambda (args, body))}
| "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)}
| -"{" scope[def][infix][atr][parse def] -"}"
@ -855,12 +853,12 @@ module Definition =
ostap (
arg : LIDENT;
position[pub][ass][coord][newp]:
%"at" s:STRING {match ass with `Nona -> Infix.at coord (unquote s) newp pub | _ -> raise (Semantic_error (Printf.sprintf "associativity for infxi '%s' can not be specified (it is inherited from that for '%s')" newp s))}
| f:(%"before" {Infix.before} | %"after" {Infix.after}) s:STRING {f coord (unquote s) newp ass pub};
%"at" s:STRING {match ass with `Nona -> Infix.at coord s newp pub | _ -> raise (Semantic_error (Printf.sprintf "associativity for infxi '%s' can not be specified (it is inherited from that for '%s')" newp s))}
| f:(%"before" {Infix.before} | %"after" {Infix.after}) s:STRING {f coord s newp ass pub};
head[infix]:
m:(%"external" {`Extern} | %"public" e:(%"external")? {match e with None -> `Public | _ -> `PublicExtern})? %"fun" name:LIDENT {unopt_mod m, name, name, infix}
| m:(%"public" {`Public})? ass:(%"infix" {`Nona} | %"infixl" {`Lefta} | %"infixr" {`Righta})
l:$ op:(s:STRING {unquote s})
l:$ op:(s:STRING {s})
md:position[match m with Some _ -> true | _ -> false][ass][l#coord][op] {
let name = Expr.infix_name op in
match md (Expr.sem name) infix with
@ -993,9 +991,9 @@ ostap (
| `Fail msg -> raise (Semantic_error msg)
in
match item with
| `Infix (_ , op, `At op') -> insert (unquote op) infix (Infix.at l#coord (unquote op') (unquote op) false)
| `Infix (ass, op, `Before op') -> insert (unquote op) infix (Infix.before l#coord (unquote op') (unquote op) ass false)
| `Infix (ass, op, `After op') -> insert (unquote op) infix (Infix.after l#coord (unquote op') (unquote op) ass false)
| `Infix (_ , op, `At op') -> insert op infix (Infix.at l#coord op' op false)
| `Infix (ass, op, `Before op') -> insert op infix (Infix.before l#coord op' op ass false)
| `Infix (ass, op, `After op') -> insert op infix (Infix.after l#coord op' op ass false)
| _ -> infix
)
infix

15
src/X86.ml
View file

@ -583,6 +583,21 @@ class env prg =
(* registers a string constant *)
method string x =
let escape x =
let n = String.length x in
let buf = Buffer.create (n*2) in
let rec iterate i =
if i < n
then (
if x.[i] = '"' then Buffer.add_string buf "\\\""
else Buffer.add_char buf x.[i];
iterate (i+1)
)
in
iterate 0;
Buffer.contents buf
in
let x = escape x in
try M.find x stringm, self
with Not_found ->
let y = Printf.sprintf "string_%d" scount in

60
stdlib/Matcher.expr Normal file
View file

@ -0,0 +1,60 @@
-- Matcher library for Ostap
fun matcherCreate (pos, buf, line, col) {
fun show () {
return sprintf ("buf : %-40s\npos : %d\nline: %d\ncol : %d\n", buf, pos, line, col)
}
fun rest () {
return buf.length - pos
}
fun shift (n) {
return matcherCreate (pos + n, buf, line, col + n)
}
fun matchString (s) {
return
if s.length > rest ()
then None
elif matchSubString (buf, s, pos) then Some (shift (s.length))
else None
fi
}
fun eof () {
return rest () == 0
}
return [
show,
eof,
matchString
]
}
fun show (m) {
return m [0]
}
fun eof (m) {
return m [1]
}
fun matchString (m, s) {
return m [2] (s)
}
fun matcherInit (buf) {
return matcherCreate (0, buf, 1, 1)
}
local m = matcherInit ("abc");
printf ("%s", m.show ());
printf ("eof: %s\n", m.eof ().string);
printf ("matchString(""u""): %s\n", case m.matchString ("u") of Some (m) -> m.show () | _ -> "None" esac);
printf ("matchString(""a""): %s\n", case m.matchString ("a") of Some (m) -> m.show () | _ -> "None" esac);
printf ("matchString(""ab""): %s\n", case m.matchString ("ab") of Some (m) -> m.show () | _ -> "None" esac);
printf ("matchString(""abc""): %s\n", case m.matchString ("abc") of Some (m) -> m.show () | _ -> "None" esac);
printf ("matchString(""abcd""): %s\n", case m.matchString ("abcd") of Some (m) -> m.show () | _ -> "None" esac)