#line 2043 "/home/ubuntu/felix/src/packages/grammar.fdoc" //$ General functional forms. syntax functions { requires expressions; //$ Anonymous function (lamda). satom := sadjectives "fun" stvarlist slambda_fun_args fun_return_type "="? scompound =># """ `(ast_lambda ,_sr (,_3 ,_4 ,(first (first _5)) ,_7)) """; //$ Anonymous function (lamda). x[slambda_pri] := sadjectives "fun" stvarlist slambda_fun_args fun_return_type "=>" sexpr =># """ `(ast_lambda ,_sr (,_3 ,_4 ,(first (first _5)) ((ast_fun_return ,_sr ,_7)))) """; //$ Anonymous function (lamda). Linear x[slambda_pri] := sadjectives "fun" stvarlist slambda_fun_args fun_return_type "=>." sexpr =># """ `(ast_linearlambda ,_sr (,_3 ,_4 ,(first (first _5)) ((ast_fun_return ,_sr ,_7)))) """; //$ Anonymous generator (lamda). satom := sadjectives "gen" stvarlist slambda_fun_args fun_return_type "="? scompound =># """ `(ast_generator ,_sr (,_3 ,_4 ,(first (first _5)) ,_7)) """; //$ Anonymous generator (lamda). x[slambda_pri] := sadjectives "gen" stvarlist slambda_fun_args fun_return_type "=>" sexpr =># """ `(ast_generator ,_sr (,_3 ,_4 ,(first (first _5)) ((ast_fun_return ,_sr ,_7)))) """; //$ Anonymous procedure (lamda). satom := sadjectives "proc" stvarlist slambda_fun_args scompound =># """ `(ast_lambda ,_sr (,_3 ,_4 (ast_void ,_sr) ,_5)) """; //$ Anonymous procedure (lamda). satom := sadjectives "proc" stvarlist scompound =># """ `(ast_lambda ,_sr (,_3 ((() none)) (ast_void ,_sr) ,_4)) """; //$ Anonymous object constructor (lamda). //$ UGLY. satom := sadjectives "object" stvarlist slambda_fun_args fun_return_type "="? scompound =># """ `(ast_object ,_sr (,_3 ,_4 ,(first (first _5)) ,_7)) """; //$ Function adjective (prefix property) inline. sadjective := "inline" =># "'InlineFunction"; //$ Function adjective (prefix property) noinline. sadjective := "noinline" =># "'NoInlineFunction"; //sadjective := "static" =># "'Static"; //$ Function adjective (prefix property) extern. sadjective := "extern" =># "'NoInlineFunction"; //$ Function adjective (prefix property) virtual. //$ In classes only. Specifies an overrideable function. sadjective := "virtual" =># "'Virtual"; //$ Function dependent on its arguments only, //$ not dependent on any variables in its enclosing context. sadjective := "pure" =># "'Pure"; //$ Function which fails to evaluate argument //$ if and only if its argument fails, //$ i.e. f (error) = error sadjective := "strict" =># "'Strict"; //$ Function which fails to evaluate argument //$ if and only if its argument fails, //$ i.e. f (error) = error sadjective := "nonstrict" =># "'NonStrict"; //$ Function may be dependent on variables in its enclosing context. sadjective := "impure" =># "'Impure"; //$ Function returns a result for all argument values. sadjective := "total" =># "'Total"; //$ Function may fail for some argument values. //$ Equivalent to a function with a non-tautologous but unknown pre-condition. sadjective := "partial" =># "'Partial"; //$ Specifies a method, in an object definition only. sadjective := "method" =># "'Method"; //$ Specifies function is to be exported under its Felix name. //$ Function must be top level and non-polymorphic. //$ Top level means the global space or a non-polymorphic class //$ nested in a top level space (recursively). sadjective := "export" =># "'Export"; sadjective := "export" sstring =># "`(NamedExport ,_2)"; sadjectives := sadjective* =># "_1"; slambda_fun_arg := "(" sparameter_comma_list "when" sexpr ")" =># "`(,_2 (some ,_4))"; slambda_fun_arg := "(" sparameter_comma_list ")" =># "`(,_2 none)"; slambda_fun_args := slambda_fun_arg+ =># "_1"; //$ Function return type specification with post-condition. fun_return_type := ":" stypeexpr "expect" sexpr =># "`((,_2 (some ,_4)) ,dflteffects)"; fun_return_type := ":" "[" stypeexpr "]" stypeexpr "expect" sexpr =># "`((,_5 (some ,_7)) ,_3)"; //$ Function return type specification without post-condition. fun_return_type := ":" stypeexpr =># "`((,_2 none) ,dflteffects)"; fun_return_type := ":" "[" stypeexpr"]" stypeexpr =># "`((,_5 none) ,_3)"; //$ Function return postcondition without type. fun_return_type := "expect" sexpr =># "`((typ_none (some ,_2)) ,dflteffects)"; fun_return_type := ":" "[" stypeexpr "]" "expect" sexpr =># "`((typ_none (some ,_6)) ,_3)"; //$ No return type. fun_return_type := ":" "[" stypeexpr "]" =># "`((typ_none none) ,_3)"; fun_return_type := sepsilon =># "`((typ_none none) ,dflteffects)"; //$ Object factory return type. object_return_type := stypeexpr =># "`(,_1 none)"; //$ Object invariant sfunction := "invariant" sexpr ";" =># "`(ast_invariant, _sr, _2)"; //$ Function parameter with type and default value. private sparameter := sparam_qual sname ":" t[sarrow_pri] "=" x[sor_condition_pri] =># "`(,_sr ,_1 ,_2 ,_4 (some ,_6))"; //$ Function parameter with type. private sparameter := sparam_qual sname ":" t[sarrow_pri] =># "`(,_sr ,_1 ,_2 ,_4 none)"; //$ Function parameter without type. //$ Defaults to polymorphic in unnamed type variable. private sparameter := sparam_qual sname =># "`(,_sr ,_1 ,_2 typ_none none)"; //$ Empty parameter tuple. //private sparameter_comma_list = list::commalist0; // parameter list including nested params private sxparam := sparameter =># "`(Satom ,_1)"; private sxparam := "(" list::commalist0 ")" =># "`(Slist ,_2)"; private sparameter_comma_list := list::commalist0 =># "`(Slist ,_1)"; //$ Parameter qualifier: val. private sparam_qual := "val" =># "'PVal"; //$ Parameter qualifier: once. private sparam_qual := "once" =># "'POnce"; //$ Parameter qualifier: var. private sparam_qual := "var" =># "'PVar"; //$ Default parameter qualifier is val. private sparam_qual := sepsilon =># "'PDef"; //$ Function tuple parameter with pre-condition. sfun_arg := "(" sparameter_comma_list "when" sexpr ")" =># "`(,_2 (some ,_4))"; //$ Function tuple parameter without pre-condition. sfun_arg := "(" sparameter_comma_list ")" =># "`(,_2 none)"; //$ Short form function parameter single polymorphic variable. sfun_arg := sname =># "`(((Satom (,_sr PVal ,_1 typ_none none))) none)"; //$ Function binder: C function. //$ A function with C function type. sfun_kind := "cfun" =># "'CFunction"; //$ Function binder: Generator. //$ A function with side effects. sfun_kind := "gen" =># "'Generator"; //$ Function binder: Function. //$ A function without side-effects. sfun_kind := "fun" =># "'Function"; stmt := sfunction =># "_1"; //$ General function definition. Multiple tuple arguments, body is expression. //$ Example: //$ //$ inline fun f (x:int when x>0) (y:long when y>0l) : long expect result > 0l => x.long + y; sfunction := sadjectives sfun_kind sdeclname sfun_arg* fun_return_type "=>" sexpr ";" =># """ (begin ;;(display "GENERAL FUNCTION") (let ((body `((ast_fun_return ,_sr ,_7)))) `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) ,(cal_funkind _1 _2) ,_1 ,body)) ) """; sfunction := sadjectives sfun_kind sdeclname sfun_arg* fun_return_type "=>." sexpr ";" =># """ (begin ;;(display "LINEAR FUNCTION") (let ((body `((ast_fun_return ,_sr ,_7)))) `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) ,(cal_funkind _1 _2) ,(cons 'LinearFunction _1) ,body)) ) """; //$ General function definition. Multiple tuple arguments, body of statements. //$ inline fun f (x:int when x>0) (y:long when y>0l) : long expect result > 0l { return x.long + y; } sfunction := sadjectives sfun_kind sdeclname sfun_arg* fun_return_type "="? scompound =># """ (begin ;;(display "COMPOUND FUNCTION") `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ,(first _5) ,(second _5) ,(cal_funkind _1 _2) ,_1 ,_7)) """; //$ Object factory definition with interface type. sfunction := "object" sdeclname sfun_arg* "implements" object_return_type "="? scompound =># """ `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,_5 Object () ,_7) """; //$ Object factory definition without interface type. sfunction := "object" sdeclname sfun_arg* "="? scompound =># """ `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 (typ_none none) Object () ,_5) """; //$ Object factory definition with inherited methods and //$ interface type. sfunction := "object" sdeclname sfun_arg* "extends" expr_comma_list "implements" object_return_type "="? scompound =># """ (begin ;; (display "object function1\n") (let* ( (d `(ast_object ,_sr (,dfltvs (,unitparam) typ_none ,_9))) ;; extension function (a `(ast_apply ,_sr (,d ()))) ;; applied to unit (x `(ast_extension ,_sr ,_5 ,a)) ;; actual extension expression (retst `(ast_fun_return ,_sr ,x)) (body `(,retst)) ) `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,_7 Function () ,body) )) """; //$ Object factory definition with inherited methods. sfunction := "object" sdeclname sfun_arg* "extends" expr_comma_list "=" scompound =># """ (begin ;; (display "object function2\n") (let* ( (noretype `(typ_none none)) (d `(ast_object ,_sr (,dfltvs (,unitparam) typ_none ,_7))) ;; extension function (a `(ast_apply ,_sr (,d ()))) ;; applied to unit (x `(ast_extension ,_sr ,_5 ,a)) ;; actual extension expression (retst `(ast_fun_return ,_sr ,x)) (body `(,retst)) ) `(ast_curry ,_sr ,(first _2) ,(second _2) ,_3 ,noretype Function () ,body) )) """; sopt_cstring := "=" scode_spec =># "`(some ,_2)"; sopt_cstring := sepsilon =># "'none"; //$ Short form function definition. Example: //$ //$ fun f : int -> int = | 0 => 0 | _ => 1; /* sfunction := sadjectives sfun_kind sdeclname fun_return_type "=" smatching+ ";" =># """ (let ( (t (first _4)) (traint (second _4)) ) (begin ;;(display "MATCHING ftype=")(display t)(display "\\n") (if (eq? 'typ_arrow (first t)) (let ( (argt (caadr t)) (ret (cadadr t)) (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,_6))))) ) `(ast_curry ,_sr ,(first _3) ,(second _3) ( (((,_sr PVal _a ,argt none)) none) ) (,ret ,traint) ,(cal_funkind _1 _2) ,_1 ,body) ) (begin (display "ERROR MATCHINGS FUNDEF ")(display _sr) 'ERROR) ) ) ) """; */ sfunction := sadjectives sfun_kind sdeclname ":" stypeexpr "=" smatching+ ";" =># """ (let ( (t _5) ) (begin ;;(display "MATCHING ftype=")(display t)(display "\n") (let ( (argt `(typ_apply ,_sr (,(nos "dom") ,t))) (ret `(typ_apply ,_sr (,(nos "cod") ,t))) (body `((ast_fun_return ,_sr (ast_match ,_sr (,(noi '_a) ,_7))))) ) `(ast_curry ,_sr ,(first _3) ,(second _3) ( ((Satom (,_sr PVal _a ,argt none)) none) ) (,ret none) ,(cal_funkind _1 _2) ,_1 ,body) ) ) ) """; sfunction := sadjectives sfun_kind sdeclname "=" sexpr ";" =># """ (let* ( (traint 'none) (t `(ast_apply ,_sr (,(nos "typeof") ,_5))) (apl `(ast_apply ,_sr (,_5 ,(noi '_a)))) (argt `(ast_apply ,_sr (,(nos "dom") ,t))) (ret `(ast_apply ,_sr (,(nos "cod") ,t))) (body `((ast_fun_return ,_sr ,apl ))) (result `(ast_curry ,_sr ,(first _3) ,(second _3) ( ((Satom (,_sr PVal _a ,argt none)) none) ) (,ret ,traint) ,(cal_funkind _1 _2) ,_1 ,body) ) ) result ) """; //$ Procedure binder. sproc_kind := "proc" =># "'Function"; //$ C procedure binder. //$ Procedure has C function type (with void result type). sproc_kind := "cproc" =># "'CFunction"; private sopt_traint_eq:= "expect" sexpr "=" =># "`((some ,_2) ,dflteffects)"; private sopt_traint_eq:= "=" =># "`(none ,dflteffects)"; private sopt_traint_eq:= sepsilon =># "`(none ,dflteffects)"; private sopt_traint_eq:= "expect" sexpr ":" "[" stypeexpr "]" "=" =># "`((some ,_2) ,_5)"; private sopt_traint_eq:= ":" "[" stypeexpr "]" "=" =># "`(none ,_3)"; private sopt_traint_eq:= ":" "[" stypeexpr "]" =># "`(none ,_3)"; private sopt_traint:= "expect" sexpr =># "`((some ,_2) ,dflteffects)"; private sopt_traint:= sepsilon =># "`(none ,dflteffects)"; private sopt_traint:= "expect" sexpr ":" "[" stypeexpr "]" =># "`((some ,_2) ,_5)"; private sopt_traint:= ":" "[" stypeexpr "]" =># "`(none ,_3)"; //$ Short form constructor function. //$ The name of the function must be a type name. //$ The return type is taken as the type with the name of the function. sfunction := "ctor" stvarlist squalified_name sfun_arg+ sopt_traint_eq scompound =># """ (let* ( (name (string-append "_ctor_" (base_of_qualified_name _3))) (vs _2) (ret _3) (traint (first _5)) (effects (second _5)) (body _6) (args _4) ) `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function () ,body)) """; sfunction := "supertype" stvarlist squalified_name sfun_arg+ sopt_traint_eq scompound =># """ (let* ( (name (string-append "_supertype_" (base_of_qualified_name _3))) (vs _2) (ret _3) (traint (first _5)) (effects (second _5)) (body _6) (args _4) ) `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function (Subtype) ,body)) """; //$ Short form constructor function. //$ The name of the function must be a type name. //$ The return type is taken as the type with the name of the function. sfunction := "ctor" stvarlist squalified_name sfun_arg+ sopt_traint "=>" sexpr ";" =># """ (let* ( (name (string-append "_ctor_" (base_of_qualified_name _3))) (vs _2) (ret _3) (traint (first _5)) (effects (second _5)) (body `((ast_fun_return ,_sr ,_7))) (args _4) ) `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function () ,body)) """; sfunction := "supertype" stvarlist squalified_name sfun_arg+ sopt_traint "=>" sexpr ";" =># """ (let* ( (name (string-append "_supertype_" (base_of_qualified_name _3))) (vs _2) (ret _3) (traint (first _5)) (effects (second _5)) (body `((ast_fun_return ,_sr ,_7))) (args _4) ) `(ast_curry_effects ,_sr ,name ,vs ,args (,ret ,traint) ,effects Function (Subtype) ,body)) """; //$ Procedure definition, general form. sfunction := sadjectives sproc_kind sdeclname sfun_arg* sopt_traint_eq scompound =># """ `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ((ast_void ,_sr) ,(first _5)) ,(second _5) ,(cal_funkind _1 _2) ,_1 ,_6) """; //$ Procedure definition, short form (one statement). sfunction := sadjectives sproc_kind sdeclname sfun_arg* sopt_traint "=>" stmt =># """ `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 ((ast_void ,_sr) ,(first _5)) ,(second _5) ,(cal_funkind _1 _2) ,_1 (,_7)) """; //$ Routine definition, general form. sfunction := sadjectives "routine" sdeclname sfun_arg* sopt_traint_eq scompound =># """ `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 (,(noi 'any) ,(first _5)) ,(second _5) Function ,_1 ,_6) """; //$ Routine definition, short form (one statement). sfunction := sadjectives "routine" sdeclname sfun_arg* sopt_traint "=>" stmt =># """ `(ast_curry_effects ,_sr ,(first _3) ,(second _3) ,_4 (,(noi 'any) ,(first _5)) ,(second _5) Function ,_1 (,_7)) """; }