diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2014-05-30 23:26:54 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2014-05-30 23:26:54 +0200 |
commit | a6bd449131cb65fc73750ab261d9997471052569 (patch) | |
tree | 82368f1b3c1522ac35e863039e771bce1254c585 /modules/language | |
parent | 3335017bcd987fcf30a1d07d6634bafeff7a09db (diff) |
major update, parser works on simple expressions
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/parser-tool.scm | 4 | ||||
-rw-r--r-- | modules/language/python/parser.scm | 403 |
2 files changed, 232 insertions, 175 deletions
diff --git a/modules/language/python/parser-tool.scm b/modules/language/python/parser-tool.scm index 754917f..cd94ef7 100644 --- a/modules/language/python/parser-tool.scm +++ b/modules/language/python/parser-tool.scm @@ -16,7 +16,7 @@ f-pk)) ;; Preliminary -(define do-print #t) +(define do-print #f) (define pp (case-lambda ((s x) @@ -42,5 +42,5 @@ ;; Sets up a standar parser functionals with INDENT field added (setup-parser <p-define> <p-lambda> <fail> <p-cc> <succeds> .. xx - X XL ((N 0) (M 0) (INDENT 0)) + X XL ((N 0) (M 0) (INDENT (list 0))) s-false s-true s-mk-seq s-mk-and s-mk-or)) diff --git a/modules/language/python/parser.scm b/modules/language/python/parser.scm index 9ea1d4f..43051ff 100644 --- a/modules/language/python/parser.scm +++ b/modules/language/python/parser.scm @@ -1,11 +1,12 @@ (define-module (language python parser) #:use-module (logic guile-log) + #:use-module ((logic guile-log parser) #:select (*whitespace*)) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) #:use-module (language python parser-tool) #:export (p)) -(define do-print #t) +(define do-print #f) (define pp (case-lambda ((s x) @@ -16,55 +17,72 @@ (when do-print (pretty-print (syntax->datum x))) x))) +(define ppp + (case-lambda + ((s x) + (pretty-print `(,s ,(syntax->datum x))) + x) + ((x) + (pretty-print (syntax->datum x)) + x))) +(define-syntax-rule (Ds f) (lambda x (apply f x))) +(define-syntax-rule (DDs op f ...) (op (lambda x (apply f x)) ...)) (define divide truncate/) ;; +++++++++++++++++++++++++++++++++++++ SCANNER SUBSECTION -(define com (f-seq "#" (f* (f-not f-nl)) f-nl)) +(define nl (f-or f-nl f-eof)) +(define com (f-seq "#" (f* (f-not f-nl)) nl)) (define w (f-reg "[\t\r| ]")) (define ws+ (f+ (f-or (f-reg "[\t\r| ]") com))) (define ws* (f+ (f-or (f-reg "[\t\r| ]") com))) (define ws ws*) -(define nl f-nl) + (define (wn_ n i) (<p-lambda> (c) - (cond - ((> i n) <fail>) - ((= i n) - (.. ((f-not w) c))) - ((< i n) - (<or> - (<and> - (.. (c) ((f-tag " ") c)) - (.. ((wn_ n (+ i 1)) c))) - (<and> - (.. (c) ((f-tag "\t") c)) - (.. ((wn_ n (divide (+ i 8) 8)) c))) - (<and> - (.. (c) ((f-tag "\r") c)) - (.. ((wn_ n i) c)))))))) + (cond + ((> i n) <fail>) + ((= i n) + (.. ((f-and (f-not w) f-true) c))) + ((< i n) + (<or> + (<and!> + (.. (c) ((f-tag " ") c)) + (.. ((wn_ n (+ i 1)) c))) + (<and!> + (.. (c) ((f-tag "\t") c)) + (.. ((wn_ n (divide (+ i 8) 8)) c))) + (<and!> + (.. (c) ((f-tag "\r") c)) + (.. ((wn_ n i) c)))))))) (define (wn+_ n i) (<p-lambda> (c) - (cond - ((> i n) + (<or> + (<and!> + (.. (c) ((f-tag " ") c)) + (.. ((wn+_ n (+ i 1)) c))) + (<and!> + (.. (c) ((f-tag "\t") c)) + (.. ((wn+_ n (divide (+ i 8) 8)) c))) + (<and!> + (.. (c) ((f-tag "\r") c)) + (.. ((wn+_ n i) c))) + (<and!> + (when (i > n)) (<with-bind> ((INDENT (cons i INDENT))) - (<p-cc> c))) - ((< i n) - (<or> - (<and> - (.. (c) ((f-tag " ") c)) - (.. ((wn+_ n (+ i 1)) c))) - (<and> - (.. (c) ((f-tag "\t") c)) - (.. ((wn+_ n (divide (+ i 8) 8)) c))) - (<and> - (.. (c) ((f-tag "\r") c)) - (.. ((wn+_ n i) c)))))))) - -(define (wn+ n) (wn+_ n 0)) -(define (wn n) (wn_ n 0)) + (<p-cc> c)))))) + +(define wn+ + (<p-lambda> (c) + (<let> ((n (car INDENT))) + (.. ((wn+_ n 0) c))))) + +(define wn + (<p-lambda> (c) + (<let> ((n (car INDENT))) + (.. ((wn_ n 0) c))))) (define indent= wn) (define indent+ wn+) @@ -377,34 +395,40 @@ (<p-cc> (list #:funcdef id pa te su))) mk-id)) -(define simple_stmt (f-list #:stmt +(define simple_stmt (f-list 'simple_stmt #:stmt (f-seq - (f-cons small_stmt - (ff* (f-seq ";" small_stmt))) - ws (f? ";") ws nl))) + (f-cons (Ds small_stmt) + (ff* (f-seq ";" (Ds small_stmt)))) + (f? ";") (f? ws) nl))) (set! small_stmt - (f-or expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt - nonlocal_stmt assert_stmt)) + (Ds + (f-or 'small expr_stmt del_stmt pass_stmt flow_stmt import_stmt global_stmt + nonlocal_stmt assert_stmt))) (set! expr_stmt - (f-seq testlist_star_expr - (f-or - (f-seq augassign - (f-or (f-or yield_expr testlist) - (f* (f-seq "=" - (f-or yield_expr - testlist_star_expr)))))))) + (f-list 'expr_stmt + #:expr-stmt + (Ds testlist_star_expr) + (f-or + (f-list #:augassign + (Ds augassign) + (f-or (Ds yield_expr) (Ds testlist))) + (f-cons #:assign + (ff* (f-seq "=" + (f-or (Ds yield_expr) + (Ds testlist_star_expr)))))))) (set! testlist_star_expr - (f-cons (f-or test star_expr) - (f-seq - (ff* (f-seq "," (f-or test star_expr))) - (f? ",")))) + (f-cons 'testlist_star_expr + (f-or (Ds test) (Ds star_expr)) + (f-seq + (ff* (f-seq "," (f-or (Ds test) (Ds star_expr)))) + (f? ",")))) (set! augassign (mk-token - (f-seq + (f-seq 'augassign ws (apply f-or! (map f-tag @@ -412,37 +436,38 @@ "<<=" ">>=" "**=" "//="))) ws))) -(set! del_stmt (f-cons #:del (f-seq "del" exprlist))) +(set! del_stmt (f-cons 'del_stmt #:del (f-seq "del" (Ds exprlist)))) -(set! pass_stmt (f-seq "pass" #:pass)) +(set! pass_stmt (f-seq 'pass_stmt "pass" #:pass)) (set! flow_stmt - (f-or + (f-or 'flow_stmt (f-seq "break" #:break) (f-seq "coninue" #:continue) - (f-cons #:return (f-seq "return" (ff? testlist))) - yield_expr + (f-cons #:return (f-seq "return" (ff? (Ds testlist)))) + (Ds yield_expr) (f-cons #:raise (f-seq "raise" - (f-or (f-cons test + (f-or (f-cons (Ds test) (ff? - (f-seq "from" test))) + (f-seq "from" (Ds test)))) (f-cons FALSE FALSE)))))) -(set! import_stmt (f-or import_name import_from)) - (set! import_name (f-seq "import" dotted_as_names)) +(set! import_stmt (f-or 'import_stmt import_name (Ds import_from))) + + (define dottir (mk-token (f-or! (f-tag! "...") (f-tag! ".")))) (define dots* (ff* dottir)) (define dots+ (ff+ dottir)) (set! import_from - (f-seq "from" + (f-seq 'import_from "from" (f-cons - (f-or (f-cons dots* dotted_name) dots+) + (f-or (f-cons dots* (Ds dotted_name)) dots+) (f-seq "import" (f-or "*" - (f-seq "(" import_as_names ")") - import_as_names))))) + (f-seq "(" (Ds import_as_names) ")") + (Ds import_as_names)))))) (define import_as_name (f-cons identifier (ff? (f-seq "as" identifier)))) @@ -465,42 +490,44 @@ (f-cons identifier (ff* (f-seq "," identifier)))) (set! global_stmt - (f-cons #:global (f-seq "global" comma_name))) + (f-cons 'global #:global (f-seq "global" comma_name))) (set! nonlocal_stmt - (f-cons #:nonlocal (f-seq "nonlocal" comma_name))) + (f-cons 'nonlocal #:nonlocal (f-seq "nonlocal" comma_name))) (set! assert_stmt - (f-cons #:assert - (f-seq "assert" (f-cons test (ff* (f-seq "," test)))))) + (f-cons 'assert #:assert + (f-seq "assert" (f-cons (Ds test) (ff* (f-seq "," (Ds test))))))) (define compound_stmt - (f-or! if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef - decorated)) + (Ds + (f-or! 'compound + if_stmt while_stmt for_stmt try_stmt with_stmt funcdef classdef + decorated))) -(define single_input (f-or! (f-seq (f-pk 1) indent= simple_stmt) - (f-seq (f-pk 2) indent= compound_stmt nl) - (f-seq (f-pk 0) nl))) +(define single_input (f-or! (f-seq indent= simple_stmt) + (f-seq indent= compound_stmt nl) + (f-seq nl))) -(set! stmt (f-or simple_stmt compound_stmt)) +(set! stmt (f-or 'stmt simple_stmt compound_stmt)) (set! if_stmt - (f-cons + (f-cons 'if_stmt #:if (f-seq "if" - (f-cons test + (f-cons (Ds test) (f-seq ":" - (f-cons suite + (f-cons (Ds suite) (f-cons (ff+ (f-seq "elif" - (f-cons test - (f-seq ":" suite)))) - (ff? (f-seq "else" ":" suite))))))))) + (f-cons (Ds test) + (f-seq ":" (Ds suite))))) + (ff? (f-seq "else" ":" (Ds suite)))))))))) (set! while_stmt - (f-cons + (f-cons 'while #:while (f-seq "while" (f-cons test @@ -509,7 +536,7 @@ (ff? (f-seq "else" ":" suite)))))))) (set! for_stmt - (f-cons + (f-cons 'for #:for (f-seq "for" (f-cons exprlist @@ -519,7 +546,7 @@ (ff? (f-seq "else" ":" suite))))))))) (set! try_stmt - (f-cons + (f-cons 'try #:try (f-seq ws "try" ":" (f-cons suite @@ -535,21 +562,22 @@ FALSE (f-seq "finally" ":" suite)))))))) +(set! with_item + (f-cons test (f-seq "as" (Ds expr)))) + (set! with_stmt - (f-cons + (f-cons 'with #:with (f-seq "with" (f-cons (f-cons with_item (ff* (f-seq "," with_item))) - (f-seq ":" suite))))) + (f-seq ":" (Ds suite)))))) -(set! with_item - (f-cons test (f-seq "as" expr))) (set! except_clause - (f-seq "except" - (ff? (f-cons test (ff? (f-seq "as" identifier)))))) + (f-seq 'except "except" + (ff? (f-cons (Ds test) (ff? (f-seq "as" identifier)))))) (set! suite (f-cons #:suite @@ -560,51 +588,59 @@ indent-)))) (set! test - (f-or + (f-or 'test (f-cons #:if - (f-cons (f-seq "if" or_test) + (f-cons (f-seq "if" (Ds or_test)) (f-seq "else" test))) - lambdef + (Ds lambdef) (f-cons (f-out #f) - (f-cons or_test FALSE)))) + (f-cons (Ds or_test) FALSE)))) (define test_nocond - (f-or or_test lambdef_nocond)) + (f-or 'nocond (Ds or_test) (Ds lambdef_nocond))) (set! lambdef - (f-cons + (f-cons 'lambdef #:lambdef - (f-cons (f-seq "lambda" (ff? varargslist '())) - (f-seq ":" test)))) + (f-cons (f-seq "lambda" (ff? (Ds varargslist) '())) + (f-seq ":" (Ds test))))) (set! lambdef_nocond - (f-cons - #:lambdef - (f-cons (f-seq "lambda" (ff? varargslist '())) + (f-cons 'lambdef_nocond + 'lambdef #:lambdef + (f-cons (f-seq "lambda" (ff? (Ds varargslist) '())) (f-seq ":" test_nocond)))) (set! or_test - (f-or! (f-cons #:or (f-cons and_test (ff+ (f-seq "or" and_test)))) - and_test)) + (p-freeze 'or_test + (f-or! 'or_test + (f-cons #:or (f-cons (Ds and_test) (ff+ (f-seq "or" (Ds and_test))))) + (Ds and_test)) + mk-id)) (set! and_test - (f-or! (f-cons #:and (f-cons not_test (ff* (f-seq "and" not_test)))) - not_test)) + (p-freeze 'and_test + (f-or! 'and_test + (f-cons #:and (f-cons (Ds not_test) (ff+ (f-seq "and" (Ds not_test))))) + (Ds not_test)) + mk-id)) (set! not_test - (f-or! - (f-cons #:not (f-seq "not" not_test)) - comparison)) + (f-or! 'not_test + (f-cons #:not (f-seq "not" not_test)) + (Ds comparison))) (set! comparison - (f-or! - (f-cons #:comp - (f-cons expr - (ff+ (f-cons comp_op expr)))) - expr)) + (p-freeze 'comparison + (f-or! 'comparison + (f-cons #:comp + (f-cons (Ds expr) + (ff+ (f-cons (Ds comp_op) (Ds expr))))) + (Ds expr)) + mk-id)) (set! comp_op - (f-or! + (f-or! 'comp_op (f-seq (f-seq "not" "in" ) (f-out "notin")) (f-seq (f-seq "is" "not") (f-out "isnot")) (apply f-or! @@ -612,80 +648,100 @@ '("<" ">" "==" ">=" "<=" "<>" "!=" "in" "is"))))) -(set! star_expr (f-cons #:starexpr (f-seq "*" expr))) +(set! star_expr (f-cons 'star_expr #:starexpr (f-seq "*" (Ds expr)))) (set! expr - (f-or! - (f-cons #:bxor (f-cons xor_expr (ff+ (f-seq "|" xor_expr)))) - xor_expr)) + (p-freeze 'expr + (f-or! 'expr + (f-cons #:bxor (f-cons (Ds xor_expr) (ff+ (f-seq "|" (Ds xor_expr))))) + (Ds xor_expr)) + mk-id)) + (set! xor_expr - (f-or! - (f-cons #:band (f-cons and_expr (ff+ (f-seq "^" and_expr)))) - and_expr)) + (p-freeze 'xor + (f-or! 'xor + (f-cons #:band (f-cons (Ds and_expr) (ff+ (f-seq "^" (Ds and_expr))))) + (Ds and_expr)) + mk-id)) (set! and_expr - (f-or! - (f-cons #:band (f-cons shift_expr (ff+ (f-seq "&" shift_expr)))) - shift_expr)) + (p-freeze 'and + (f-or! 'and + (f-cons #:band (f-cons (Ds shift_expr) + (ff+ (f-seq "&" (Ds shift_expr))))) + (Ds shift_expr)) + mk-id)) (set! shift_expr - (f-or! - (f-cons #:<< (f-cons arith_expr (ff+ (f-seq "<<" arith_expr)))) - (f-cons #:>> (f-cons arith_expr (ff+ (f-seq ">>" arith_expr)))) - arith_expr)) + (p-freeze 'shift + (f-or! 'shift + (f-cons #:<< (f-cons (Ds arith_expr) (ff+ (f-seq "<<" (Ds arith_expr) )))) + (f-cons #:>> (f-cons (Ds arith_expr) (ff+ (f-seq ">>" (Ds arith_expr) )))) + (Ds arith_expr)) + mk-id)) (set! arith_expr - (f-or! - (f-cons #:+ (f-cons term (ff+ (f-seq "+" term)))) - (f-cons #:- (f-cons term (ff+ (f-seq "-" term)))) - term)) + (p-freeze 'arith + (f-or! 'arith + (f-cons #:+ (f-cons (Ds term) (ff+ (f-seq 'rest "+" (Ds term) )))) + (f-cons #:- (f-cons (Ds term) (ff+ (f-seq "-" (Ds term) )))) + (f-seq 'single_term (Ds term))) + mk-id)) (set! term - (f-or! - (f-cons #:* (f-cons factor (ff+ (f-seq "*" factor)))) - (f-cons #:// (f-cons factor (ff+ (f-seq "//" factor)))) - (f-cons #:/ (f-cons factor (ff+ (f-seq "/" factor)))) - (f-cons #:% (f-cons factor (ff+ (f-seq "%" factor)))) - factor)) + (p-freeze 'term + (f-or! 'term + (f-cons #:* (f-cons (Ds factor) (ff+ (f-seq "*" (Ds factor) )))) + (f-cons #:// (f-cons (Ds factor) (ff+ (f-seq "//" (Ds factor) )))) + (f-cons #:/ (f-cons (Ds factor) (ff+ (f-seq "/" (Ds factor) )))) + (f-cons #:% (f-cons (Ds factor) (ff+ (f-seq "%" (Ds factor) )))) + (f-seq 'single-factor (Ds factor))) + mk-id)) (set! factor - (f-or! - (f-cons #:u+ (f-seq "+" factor)) - (f-cons #:u- (f-seq "-" factor)) - (f-cons #:u~ (f-seq "~" factor)) - power)) + (p-freeze 'factor + (f-or! 'factor + (f-cons #:u+ (f-seq "+" factor)) + (f-cons #:u- (f-seq "-" factor)) + (f-cons #:u~ (f-seq "~" factor)) + (Ds power)) + mk-id)) (set! power - (f-cons #:power - (f-cons atom - (f-cons (ff* trailer) - (f-or! (f-seq "**" factor) - FALSE))))) + (p-freeze 'power + (f-cons 'power #:power + (f-cons (Ds atom) + (f-cons (ff* (Ds trailer)) + (f-or! (f-seq "**" factor) + FALSE)))) + mk-id)) (set! trailer - (f-or! - (f-seq "(" (ff? arglist) ")") - (f-seq "[" subscriptlist "]") + (f-or! 'trailer + (f-seq "(" (ff? (Ds arglist)) ")") + (f-seq "[" (Ds subscriptlist) "]") (f-seq "." identifier))) (set! atom - (f-or! + (p-freeze 'atom + (f-or! 'atom (f-cons #:subexpr - (f-seq "(" ff? (f-or! yield_expr testlist_comp) ")")) + (f-seq "(" (ff? (f-or! (Ds yield_expr) (Ds testlist_comp))) ")")) (f-cons #:list - (f-seq "[" (ff? testlist_comp) ")")) + (f-seq "[" (ff? (Ds testlist_comp)) ")")) (f-cons #:dict - (f-seq "{" (ff? dictorsetmaker) "}")) - identifier - number + (f-seq "{" (ff? (Ds dictorsetmaker)) "}")) + (f-seq 'identifier identifier) + (f-seq 'number number) (f-cons #:string (ff+ string)) (f-cons #:... "...") (f-cons #:None "None") (f-cons #:True "True") - (f-cons #:false "False"))) + (f-cons #:false "False")) + mk-id)) (set! testlist_comp (f-cons @@ -698,11 +754,11 @@ (set! subscriptlist (f-cons subscript - (f-seq (ff* (f-seq "," subscript)) (f? ",")))) + (f-seq (ff* (f-seq "," (Ds subscript))) (f? ",")))) (set! subscript (f-or! - (f-list (ff? test) ":" (ff? test) (ff? sliceop)) + (f-list (ff? test) ":" (ff? test) (ff? (Ds sliceop))) (f-list test FALSE FALSE))) (set! sliceop @@ -721,34 +777,34 @@ (let ((f (f-cons test (f-seq ":" test)))) (f-or! (f-cons* f (f-seq (ff* (f-seq "," f)) (f? ","))) - (f-cons f comp_for) - (f-cons test comp_for) + (f-cons f (Ds comp_for)) + (f-cons test (Ds comp_for)) (f-cons test (f-seq (ff* (f-seq "," test)) (f? ",")))))) (set! classdef (f-list #:classdef (f-seq "class" identifier) - (ff? (f-seq "(" (ff? arglist '()) ")")) + (ff? (f-seq "(" (ff? (Ds arglist) '()) ")")) (f-seq ":" suite))) (set! arglist (f-or! - (f-list (f-seq (ff+ (f-seq argument ",")) (f? ",")) + (f-list (f-seq (ff+ (f-seq (Ds argument) ",")) (f? ",")) FALSE FALSE) - (f-list (f-seq (ff* (f-seq argument ","))) + (f-list (f-seq (ff* (f-seq (Ds argument) ","))) FALSE (ff? (f-seq "**" test))) - (f-list (f-seq (ff* (f-seq argument ","))) - (f-seq "*" (f-cons test (ff* (f-seq "," argument)))) + (f-list (f-seq (ff* (f-seq (Ds argument) ","))) + (f-seq "*" (f-cons test (ff* (f-seq "," (Ds argument))))) (ff? (f-seq "," "**" test))))) (set! argument (f-or! (f-list #:= test (f-seq "=" test)) - (f-list #:comp test (ff? comp_for)))) + (f-list #:comp test (ff? (Ds comp_for))))) -(define comp_iter (f-or! comp_for comp_if)) +(define comp_iter (f-or! (Ds comp_for) (Ds comp_if))) (define comp_for (f-list (f-seq "for" exprlist) (f-seq "in" or_test) (ff? comp_iter))) @@ -756,7 +812,7 @@ (ff? comp_iter))) (set! yield_expr - (f-list #:yield (f-seq "yield" (ff? yield_arg)))) + (f-list #:yield (f-seq "yield" (ff? (Ds yield_arg))))) (set! yield_arg (f-or! @@ -765,5 +821,6 @@ (define (p str) - (pp (parse str single_input)) - (if #f #f)) + (with-fluids ((*whitespace* (f* (f-reg "[ \t\r]")))) + (ppp (parse str (f-seq nl single_input))) + (if #f #f))) |