[Git][monnier/typer][alice] correction sform
Alice de Berny pushed to branch alice at Stefan / Typer Commits: ed3cbc75 by irradiee at 2020-06-02T12:47:36-04:00 correction sform - - - - - 1 changed file: - src/elab.ml Changes: ===================================== src/elab.ml ===================================== @@ -1366,11 +1366,13 @@ and sform_add_attribute ctx loc (sargs : sexp list) ot = (mkBuiltin ((loc, "add-attribute"), attr_type, Some table), Lazy) -and get_attribute ctx loc largs = - let ctx_n = get_size ctx in - let table, var = match largs with - | [table; (Var((_, Some name), _), idx)] -> table, (ctx_n - idx, name) - | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in + + and get_attribute ctx loc largs = + let ctx_n = get_size ctx in + let table, var = match largs with + | [table; (Var((_, Some name), idx), _)] -> table, (ctx_n - idx, name) + | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in + let map = match OL.lexp'_whnf table (ectx_to_lctx ctx) with @@ -1388,9 +1390,10 @@ and sform_get_attribute ctx loc (sargs : sexp list) ot = and sform_has_attribute ctx loc (sargs : sexp list) ot = let n = get_size ctx in let table, var = match List.map (lexp_parse_sexp ctx) sargs with - | [table; (Var((_, Some name), _), idx)] -> table, (n - idx, name) + | [table; (Var((_, Some name), idx), _)] -> table, (n - idx, name) | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in + let map, attr_type = let lp = OL.lexp_whnf table (ectx_to_lctx ctx) in match lexp_lexp' lp with @@ -1400,23 +1403,25 @@ and sform_has_attribute ctx loc (sargs : sexp list) ot = (BI.o2l_bool ctx (AttributeMap.mem var map), Lazy) -and sform_declexpr ctx loc sargs ot = - match List.map (lexp_parse_sexp ctx) sargs with - | [(Var((_, vn), _), vi)] - -> (match DB.env_lookup_expr ctx ((loc, vn), vi) with - | Some lxp -> (lxp, Lazy) - | None -> error ~loc "no expr available"; - sform_dummy_ret ctx loc) - | _ -> error ~loc "declexpr expects one argument"; - sform_dummy_ret ctx loc + and sform_declexpr ctx loc sargs ot = + match List.map (lexp_parse_sexp ctx) sargs with + | [(Var((_, vn), vi), _)] + -> (match DB.env_lookup_expr ctx ((loc, vn), vi) with + | Some lxp -> (lxp, Lazy) + | None -> error ~loc "no expr available"; + sform_dummy_ret ctx loc) + | _ -> error ~loc "declexpr expects one argument"; + sform_dummy_ret ctx loc + + + let sform_decltype ctx loc sargs ot = + match List.map (lexp_parse_sexp ctx) sargs with + | [(Var((_, vn), vi), _)] + -> (DB.env_lookup_type ctx ((loc, vn), vi), Lazy) + | _ -> error ~loc "decltype expects one argument"; + sform_dummy_ret ctx loc -let sform_decltype ctx loc sargs ot = - match List.map (lexp_parse_sexp ctx) sargs with - | [(Var((_, vn), _), vi)] - -> (DB.env_lookup_type ctx ((loc, vn), vi), Lazy) - | _ -> error ~loc "decltype expects one argument"; - sform_dummy_ret ctx loc let builtin_value_types : ltype option SMap.t ref = ref SMap.empty View it on GitLab: https://gitlab.com/monnier/typer/-/commit/ed3cbc752545ab8d132c5623fceb2cef83... -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/ed3cbc752545ab8d132c5623fceb2cef83... You're receiving this email because of your account on gitlab.com.
Afficher les réponses par date
participants (1)
-
Alice de Berny